perm filename GAP[NS,SYS]4 blob
sn#117847 filedate 1974-09-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00038 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 Definitions. The file DEFS must be assembled with this file.
C00006 00003 storage allocations for file I/O
C00010 00004 display storage
C00019 00005 misc. storage
C00027 00006 switches, flags
C00034 00007 GAP
C00037 00008 MAIN
C00042 00009 LSTINI APMESS DPYINI DPYEND
C00045 00010 READ0 READ READY GETCH GETDPY
C00048 00011 SETSWT CLRSWT SWSCAN GETSWT FINDSW
C00054 00012 FROM TO ON DATES PDATE RDDATE TOMCHK AFTER BEFORE RDTIME PTIME
C00066 00013 UUCODE INTRPT DECOUT DPYNUM OCTOUT CMDXIT
C00070 00014 DELALL DELNTF GETNTF NOTIFY DSPALL DELRQS
C00071 00015 XSCAN TERM FACTOR PRIMAR
C00074 00016 GETWD GETSEQ GETREC COMCHK SUFCHK
C00083 00017 INNBR RDNBR SAVPOL DAY1ST INNBR0 RDNBR0
C00085 00018 EXCHAN TELLSW SIXOUT TYPESW UPDATE UNSEEN SETFRM SIXTYP
C00089 00019 FLSCAN
C00091 00020 GETFIL NOLOOK NOENTR PRFILE
C00098 00021 MAKLST COUNT
C00106 00022 ONEDAY SETOP RETLST NOLIST ONE0 NXTWD NXTERM FOUND FIVOUT COPYL-M
C00134 00023 REDDAT GETDAT CHKSEE
C00141 00024 RELLST
C00143 00025 REDHED
C00154 00026 REVCUR INSHED
C00157 00027 REDSTY REDST0
C00164 00028 GETSTY
C00168 00029 SHOW SMAIN DISTAB ILLCMD
C00175 00030 PRESEN PRETTY
C00181 00031 NFRAME PFRAME NPART PPART NSTORY PSTORY DOCNT SETDSP TOEND TOBEG PREST
C00194 00032 REDRAW XIT0 XIT QUIT TRYDDT QUEST HELPDP GETARG NOARG HELP
C00197 00033 XCOMM
C00199 00034 INHEAD DSTORY DPART PUTFIL PUTLPT PUTXGP CLSFIL UNSPOO
C00205 00035 INFILE FREAD FGETCH INFILC
C00211 00036 OUTFIL OUTSW SPOOL XSPOOL
C00226 00037 SETTIM SETBEG SETEND EDT PDT
C00232 00038 DATA PATCH
C00233 ENDMK
C⊗;
;Definitions. The file DEFS must be assembled with this file.
IFNDEF DEBUG <DEBUG←0>
TITLE GAP -- retriever of AP stories
FAKE←←0 ;NO FAKE STORIES
MULTWD←←1 ;allow LOS ANGELES to mean LOS * ANGELES
F←0
A←1
B←2
C←3 ;current character
D←4
E←5 ;counter and temporary AC
L←6
M←7
N←10
Q←11 ;byte pointer
R←12 ;temporary byte pointer
W←13 ;W:Z are used as LOOKUP and ENTER block
X←14
Y←15
Z←16
P←17 ;pdl pointer
;I/O channels
TXT←←1 ;text input from .TXT file
UFD←←2 ;input from UFD
DAT←←3 ;input from .DAT file
FLI←←4 ;input from command file (eg, OPTION.TXT)
FLO←←5 ;output of stories to file (eg, NS.NS)
SPL←←6 ;output of spooler command file (*.SPX[SPL,SYS])
DEFINE SYNERR(MSG) <UERROR [ASCIZ ⊗MSG⊗]>
DEFINE SPCERR(MSG) <UERROR 1,[ASCIZ ⊗MSG⊗]> ;DON'T TYPE OUT INPUT EXPRESSION
XALL
NOLIT
; storage allocations for file I/O
;XWIRES DEFINES NWIRES AND WIRES
XWIRES
IFN DEBUG <
LSYM←←4000
SYM: BLOCK LSYM
>;END IFN DEBUG
DSK17: 17
SIXBIT /DSK/
0
NTIBUF←←=14 ;number of records in story buffer--must hold whole story
LBUF←←200*NTIBUF
OLDBUF: BLOCK 200 ;buffer for holding leftover text that needs to be OUTPUT
BLOCK 200 ;buffer for holding first part of record where story starts
BUF: BLOCK LBUF ;story buffer for holding entire story
TXTCMD: IOWD LBUF,BUF ;dump mode command for reading in story from .TXT file
0
DATCMD: IOWD 1,DATA ;dump mode command for reading .DAT goes here
0
FLOCMD: IOWD 1,OLDBUF ;dump mode command for writing output file goes here
0
FLOCM2: IOWD 200,OLDBUF ;dump mode command for writing 200 words
0
AMT: 0 ;number of words of text in OLDBUF currently
NUBUFS←←2
UFDBUF: BLOCK 203*NUBUFS;buffer space for reading UFD
UBUF: BLOCK 3 ;buffer header for reading UFD
DIFILE: SIXBIT /OPTION/;default input file (command file) name
SIXBIT /TXT/
0↔0
DOFILE: SIXBIT /NS/ ;default output file name
SIXBIT /NS/
0↔0
DSFILE: SIXBIT /$$NS00/ ;default output file name when spooling only
SIXBIT /NS/
0
DATE00: BLOCK NWIRES ;ONE WORD PER WIRE, WITH OLDEST DATE OF NEWS
DDFILE: SIXBIT /DATE00/ ;file containing date of earliest available news
SIXBIT /DAT/
0
NSPPN
DDCMD: IOWD NWIRES,DATE00
0
OFILE: BLOCK 4 ;NAME OF OUTPUT FILE SAVED HERE
FILEF: BLOCK 4 ;LOOKUP-TYPE BLOCK FOR OUTPUT FILENAME
NIBUFS←←2
IBUFS: BLOCK 203*NIBUFS;buffer space for reading command file
IBUF: BLOCK 3 ;input buffer header for command file
ERRBK: SIXBIT /DSK/ ;BLOCK FOR STARTING ERROR PROGRAM ON ANOTHER JOB
ERRPRG ;PROGRAM NAME
'DMP',,14 ;START ON ANOTHER JOB NOT LOGGED IN
1 ;STARTING ADDRESS INCREMENT
NSPPN
NSPPN
; display storage
LSHORT←←5 ;NUMBER OF LINES OF PREVIEW TYPED
FRSMAX←←=15 ;MAXIMUM SIZE DPY FRAME CAN BE
MAXFRS←←=20 ;MAXIMUM NUMBER OF FRAMES STORY CAN HAVE
FRSIZE: FRSMAX ;NUMBER OF LINES PER FRAME OF DISPLAYED STORY
FREND: BLOCK MAXFRS+2 ;BYTE POINTERS TO THE END OF EACH FRAME OF A STORY
LASTFR: 0 ;NUMBER OF LAST FRAME OF CURRENT IN-CORE STORY
DDHDR: 200000,,0 ;DPY HEADER FOR DISPLAYING STORY
BLOCK 3
HDRHDR: 200000,,HDRPRG ;DPY HEADER FOR DISPLAYING HEADER LINE ABOVE STORY
LHDR
0
HDRPRG+1
HDRPRG: BLOCK 2
ASCID /................STORY /
HDRS1: ASCID /1/
HDRS3: ASCID / OF /
HDRS2: ASCID /1/
ASCID /..../
HDRDL: ASCID /DL/
ASCID /..../
HDRP0: 1 ;ASCID /PART /
HDRP1: 1
HDRP3: 1 ;ASCID / OF /
HDRP2: 1
ASCID /................
/
0
LHDR←←.-HDRPRG
ARRHDR: 200000,,ARRPRG ;DPY HEADER FOR DISPLAYING ARROW MARKING MIDDLE OF SCREEN
LARR
0
ARRPRG+1
ARRPRG: BLOCK 2
ASCID /→
/
0
LARR←←.-ARRPRG
TRLHDR: 600000,,TRLPRG ;DPY HEADER FOR DISPLAYING ROW OF DASHES AT BOTTOM OF SCREEN
LTRL
0
TRLPRG+1
TRLPRG: BLOCK 2
ASCID /--------
/]
0
LTRL←←.-TRLPRG
DDEHDR: 200000,,DDCOMW ;DPY HEADER FOR ERASING DD SCREEN
LDDE
0
DDHDRP
DDCOMW: CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA ;STANDARD CW FOR ALL DD DISPLAYING
DDHDRP: CW COLM,2,HILIN,1,LOLIN,10 ;POSITION FOR HEADER LINE
REPEAT 8,<BYTE (7) 40,12,40,12,40 (1)1 (7) 12,40,12,40,12 (1)1>
0 ;THE ABOVE PRG ERASES WHOLE DD SCREEN
LDDE←←.-DDCOMW
HLPHDR: 600000,,HLPPRG ;DPY HEADER FOR DISPLAYING SOME HELP INFORMATION
LHLP
0
HLPPRG+1
HLPPRG: BLOCK 2
COMMON:
XLIST
ASCID ⊗********
Commands to move around in the story list come in pairs:
one to move forward in the list and
one to move backward in the list.
There are three basic distances you can move in the story list:
1) to the next "frame" of the current part.
2) to the next "part" (substory) of the current story.
3) to the next "story".
Main commands:
U - advance to next story I - backup to previous story
J - advance to next part K - backup to previous part
M - advance to next frame , - (comma) backup to previous frame
<carriage return> - on teletypes, same as M; on displays, ignored
<decimal number> - repeat following command, but not beyond last
frame, part or story (depending on command).
CONTROL or META on a command moves to last frame, part or story.
Others:
<altmode> - cancel numerical argument
E - Exit to monitor (on displays, must be CONTROL-META-E)
Q - Quit displaying stories--read command line next
X - accept eXtended command next
? - display this list⊗↔1↔ASCID ⊗
V - redraw story on display screen
********
⊗
LIST
0
LHLP←←.-HLPPRG
HP2HDR: 600000,,HP2PRG ;DPY HEADER FOR DISPLAYING SOME HELP INFORMATION
LHP2
0
HP2PRG+1
HP2PRG: BLOCK 2
COMMO2:
XLIST
ASCID ⊗********
A command line should be entered whenever "*KEY: " is typed out
and can contain switches and/or a keyword expression.
Mode switches (/CHRONO /SHOW /DPY /HEADLI /AGAIN) appearing after a
keyword expression are temporary only. Elsewhere they are permanent.
Date switches (/FROM, /TO, /ON, /DURING) must be followed by a date
of one of the forms: 24-MAY-74, 24-MAY, MAY, TUESDAY, or TODAY.
A command switch (e.g., /HELP or /EXIT or /OUTPUT) may appear only by
itself. (Some command switches can be followed by arguments.)
Type /SWITCH to get a list of available switches.
Type /DATES to have your current date range typed out.
Type /MODES to have your current modes typed out.
A keyword expression is made up of words (keywords) combined with
the operators *, + and -.
WAR * PEACE represents all stories containing both War and Peace.
WAR + PEACE represents all stories containing either War or Peace.
WAR - PEACE represents all stories containing War but not Peace.
Parentheses can be used freely in keyword expressions.
If an expression starts with +, - or *, that expression will be used
as the second argument of the given operation, with the first argument
being the last keyword expression you used.
For a more complete description of this program and the News Service
system, read the file NS.ME[S,DOC].
********
⊗
LIST
0
LHP2←←.-HP2PRG
; XPOS,YPOS BRT,SIZE
IIHDRP: BYTE (11)<-777>,700 (3)2,2 (2)1,2 (4)6 ;HEADER LINE
IIFRMP: BYTE (11)<-777>,640 (3)2,2 (2)1,2 (4)6 ;STORY
IIARRW: BYTE (11)<-1020>,104 (3)2,2 (2)1,2 (4)6 ;ARROW POINTING TO MIDDLE
IITRLP: BYTE (11)<-777>,<-460> (3)2,2 (2)1,2 (4)6 ;TRAILING LINES OF DASHES
;DDHDRP: SEE DDEHDR ABOVE ;POSITION FOR HEADER LINE
DDFRMP: CW COLM,2,HILIN,2,LOLIN,4 ;POSITION FOR FIRST LINE OF STORY DISPLAYED
DDARRW: CW COLM,1,HILIN,15,LOLIN,2 ;POSITION FOR ARROW POINTING TO MIDDLE
DDTRLP: CW COLM,2,HILIN,30,LOLIN,14 ;POSITION FOR TRAILING LINE OF DASHES
DDARRC: CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA+20 ;REPLACEMENT BIT ON FOR ARROW COMM WORD
;DDCOMW: SEE DDEHDR ABOVE ;STANDARD CW FOR ALL DD DISPLAYING
COMMENT ⊗ III POG numbers:
0 STORY
1 HEADER LINE
2 TRAILING LINE
3 ARROW
end of comment ⊗
; misc. storage
LPDL←←30
PDL: BLOCK LPDL ;pushdown list
MONTH: FOR MON IN (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)
< ASCII \MON-\
>
MONTH6: FOR DATE IN (January,February,March,April,May,<June>
,July,August,September,October,November,<December>
,Wednesday,Thursday,Friday,Saturday,Sunday,Monday,<Tuesday>
,Today,Yesterday)
< <SIXBIT \DATE\>
>
WEEK: FOR DAY IN (Wednesday,Thursday,Friday,Saturday,Sunday,Monday,Tuesday)
< ASCIZ \DAY\
>
BACMON: 0↔0↔3↔0↔1↔0↔1↔0↔0↔1↔0↔1
ABSMINDATE←←7113 ;7 JAN 74 in DAYCNT format
ABSMAXDATE←←7665 ;4 JAN 75 in DAYCNT format
MAY13←←7420 ;13 MAY 74 IN system date format
CWIRE: 0 ;CODE OF WIRE SERVICE WHOSE DATA IS TO BE READ IN
ALLOK: 0 ;NON-ZERO IF USER IS ALLOWED TO SEE ALL WIRE SERVICES
WIREIN: -1 ;CODE OF WIRE SERVICE DATA CURRENTLY IN CORE
LLISTS←←2000 ;MAX NUMBER OF STORY LIST ELEMENTS
STYLST: BLOCK LLISTS ;STYLST+0 IS FREE HDR. SEE DESCRIPTION OF LST,PTR,FOL BELOW
STYPTR: BLOCK LLISTS ;STYPTR+0 IS LAST ELEMENT IN STYLST ARRAY.
STYFOL: BLOCK LLISTS ;STYFOL+0 IS LAST ELEMENT IN STYPTR ARRAY.
STYTIM: BLOCK LLISTS+1 ;STYTIM+0 IS LAST ELEMENT IN STYFOL ARRRY.
COMMENT ⊗ EACH ELEMENT IN A STORY LIST CONSISTS OF THREE WORDS, ONE FROM EACH OF
THE ARRAYS: STYLST, STYPTR, & STYFOL. FORMAT IS THE FOLLOWING:
STYLST+0: 0,,<ptr to first free story list element>
STYLST+N: <back ptr in list> ,, <forward ptr in list>
STYPTR+N: <dump mode word count> ,, <address of story within .TXT file>
STYFOL+N: <index of wire source> ,, <follow-up ptr>
STYTIM+N: <date (originals only)> ,, <time of story in minutes>
end of comment ⊗
LSEEN←←400 ;MAX NUMBER OF PRESENTED STORIES WE WILL KEEP TRACK OF
SEEN: 0 ;NUMBER OF DIFFERENT STORIES PRESENTED
BLOCK LSEEN ;SEQUENTIAL LIST OF STORIES SEEN: <DATE>,,<PTR TO TEXT>
ASEEN: 0 ;NBR OF STORIES DISCARDED FOR HAVING ALREADY BEEN SEEN
TTMS: SIXBIT /TTY/ ;TTYMES HEADER FOR ERROR MESSAGES
0 ;POINTER TO ASCIZ TEXT WILL GO HERE
SORRY: ASCIZ /SORRY -- /]
CRLF: ASCIZ /
/
TMPOFF: 0
TMPON: 0
PRMOFF: 0
PRMON: 0
NDATE1: 0 ;NEW BEGINNING DATE (SYSTEM DATE FORMAT)
NDATE2: 0 ;NEW ENDING DATE
NTIME1: 0 ;NEW BEGINNING TIME (IN MINUTES)
NTIME2: 0 ;NEW ENDING TIME
PERM: 0 ;PERMANENT VALUES OF TMP/PERM FLAGS
CURREN: 0 ;CURRENT STORY LIST HEADER
PREVIO: 0 ;PREVIOUS STORY LIST HEADER
NCURR: 0 ;NUMBER OF STORIES IN CURRENT STORY LIST
NPREV: 0 ;NUMBER OF STORIES IN PREVIOUS STORY LIST
FCURR: 0 ;NUMBER OF FIRST STORY IN CURRENT STORY LIST: EITHER 0 OR 1
FPREV: 0 ;NUMBER OF FIRST STORY IN PREVIOUS STORY LIST
BLEN←←50
BUF1: BLOCK BLEN ;TEMP BUFFER YET UNUSED
BUF2: BLOCK BLEN ;TEMP BUFFER USED BY: GETSWT, READY, TELLSW, HELP, DECOUT, PRFILE
TYBUF: BLOCK BLEN ;BUFFER FOR HOLDING COMMAND TYPED
TYEND: POINT 7,.-1,6 ;BYTE POINTER TO LAST LEGAL BYTE IN TYBUF
POLISH: BLOCK 2000 ;BLOCK FOR HOLDING POLISH FOR EXPRESSION
POLEND←←.-2 ;LAST WORD OF POLISH BLOCK (WITH ROOM TO SPARE)
POLX: 0 ;PTR TO CURRENT PLACE IN POLISH WHILE SCANNING EXPR
POLPNT: 0 ;PTR TO END OF LAST EXPR SUCCESSFULLY SCANNED INTO POLISH
DATIN: 0 ;date (in DAYCNT format) of any .DAT file in core
DATE1: 0 ;BEGINNING DATE OF RANGE, IN DAYCNT FORMAT
DATE2: 0 ;ENDING DATE OF RANGE, IN DAYCNT FORMAT
TIME1: -1 ;TIME OF BEGINNING OF DATE RANGE ON DATE1 (-1 MEANS NOT USED)
TIME2: -1 ;TIME OF ENDING OF DATE RANGE ON DATE2 (-1 MEANS NOT USED)
SDATE1: 0 ;BEGINNING DATE OF RANGE, IN SYSTEM DATE FORMAT
SDATE2: 0 ;ENDING DATE OF RANGE, IN DAYCNT FORMAT
OLDDAT: 0 ;DAYCNT DATE FOR WHICH WE HAVE ALREADY MADE A STORY LIST
OLDWIR: -1 ;WIRE CODE FOR OLDDAT
TODAY: 0 ;today's date in DAYCNT format
STODAY: 0 ;today's date in system date format
SFSTDA: 0 ;date of oldest available news, in system date format
LINTYP: -1 ;KIND OF TERMINAL USER IS ON: -1=TTY, 0=DD, 0,,-1=III
FRONT: 0 ;PTR TO FRONT OF NEW STORY LIST
BACK: 0 ;PTR TO BACK OF NEW STORY LIST
STYBEG: 0 ;ptr to first word in story currently in core
STYEND: 0 ;ptr to first word beyond end of story in core
SEQNBR: 0 ;sequence number of current story
HNGTIM: 0 ;number of times we have tried to do an LOOKUP and failed
THISTY: 0 ;number of current story within current story list
SUBSTY: 0 ;number of current substory within substory list
NPARTS: 0 ;number of substories in current substory list
HEADIN: 0 ;ADDRESS,,LENGTH of headline story in core
HLINES: 0 ;requested number of lines/story in headline story
ALINES: 0 ;actual number of lines/story in headline story
LINLEN: 0 ;max length of a line in headline story
ARG: 0 ;numerical argument for display command
USRPPN: 0 ;logged in PPN of user
ESCIFG: 0 ;flag indicating if ESC-I has just been typed
DATEND: BLOCK NWIRES ;length marker for today's DAT file to see if new news is in
TTSIZE: 0,,-1 ;size of frames for typing in TTY mode
; switches, flags
DEFINE SWITCH <
IFN DEBUG <
XX DDT,TRYDDT,ONLY
>
XX HELP,HELP,ONLY
XX EXIT,XIT,ONLY
XX SWITCH,TYPESW,ONLY
XX MODES,TELLSW,ONLY
XX INPUT,INFILC,ONLY
XX INFILE,INFILE,ONLY!SWARG
XX OUTPUT,OUTFIL,ONLY!SWARG
XX XSPOOL,XSPOOL,ONLY
XX SPOOL,SPOOL,ONLY
XX EXCHANGE,EXCHAN,ONLY
XX REVERSE,REVCUR,ONLY
XX COUNT,COUNT,ONLY
XX UPDATE,UPDATE
XX FRAME,SETFRM
XX DATES,DATES,ONLY
XX PRESENT,SHOW,ONLY
XX UNSEEN,UNSEEN,ONLY
IFDEF SWDSP, <LONLY←←.-SWDSP> ;COMMAND SWITCHES
XX BEFORE,BEFORE
XX AFTER,AFTER
XX DURING,ON
XX ON,ON
XX TO,TO
XX FROM,FROM
IFDEF SWDSP, <LDATE←←.-SWDSP> ;DATE SWITCHES
; XX EQUAL,SETSWT,EQUALB
; XX EXPAND,SETSWT,XPANDB
; XX GETNOTIF,GETNTF,ONLY
; XX DELNOTIF,DELNTF,ONLY
; XX NOTIFY,NOTIFY,ONLY
; XX DELALLREQUESTS,DELALL,ONLY
; XX DISPLAYREQUESTS,DSPALL,ONLY
; XX DELREQUESTS,DELRQS,ONLY
XX AP,SETSWT,APB
XX NYT,SETSWT,NYTB
XX AGAIN,SETSWT,AGAINB
XX HEADLINES,HEADLI,HEADLB
XX DPY,SETSWT,DPYB
XX SHOW,SETSWT,SHOWB
XX CHRONOLOGICAL,SETSWT,CHRONB
>
DEFINE XX(NAME,ADR,BITS) <
<SIXBIT /NAME/>
>
SWNAMS: SWITCH ;TABLE OF SWITCH NAMES
LSWIT←←.-SWNAMS ;NUMBER OF SWITCHES IN TABLE
DEFINE XX(NAME,ADR,BITS) <
BITS,,ADR
>
SWDSP: SWITCH ;TABLE OF SWITCH BITS AND DISPATCH ADDRESSES
;SPECIAL FLAG IN DISPATCH TABLE (VALUE MUST NOT BE DUPLICATED IN RH TMP/PERM FLAGS)
ONLY ←← 400000 ;SWITCH MUST APPEAR ONLY BY ITSELF. THIS BIT MUST BE SIGN BIT.
;RIGHT-HALF FLAGS (TEMPORARY VALUE IN F, PERMANENT VALUE IN "PERM")
ASKB ←← 200000 ;Ask the user which stories should go into output file, list.
DPYB ←← 100000 ;The user is on a DD or III display.
AGAINB←← 40000 ;Present stories the user has already seen.
FIRSTB←← 20000 ;Present only the first part of each story.
EQUALB←← 10000 ;Keyword twins should be considered equal.
XPANDB←← 4000 ;Keyword structures should be expanded.
SPOOLB←← 2000 ;Output file is to be spooled.
CHOOSB←← 1000 ;User is choosing which stories he wants to see in full.
HUSHB ←← 400 ;Don't present any stories (useful if outputting to a file).
SHOWB ←← 200 ;Automatically show user stories after a keyw expr.
CHRONB←← 100 ;Make story list be in chronological order.
HEADLB←← 40 ;Include headline story as first story in list.
SWARG ←← 20 ;This "ONLY" switch takes an argument
APB ←← 10 ;Wants AP news
NYTB ←← 4 ;wants NY Times news
WIRSB ←←APB!NYTB;all wires
PERMSK←←ASKB!DPYB!AGAINB!FIRSTB!EQUALB!XPANDB!SPOOLB!CHOOSB!HUSHB!SHOWB!CHRONB!HEADLB!WIRSB
;bits copied into temporary flag word from permanent flag word
WIRESB: NYTB
APB
;MISC LEFT-HALF FLAGS
EXPRB ←← 1 ;A KEYWORD EXPRESSION HAS BEEN SEEN--CANT HAVE ANOTHER
TMP1B ←← 2 ;TMP FLAG USED IN: MAKLST (ONEDAY), SHOW, GETFIL, INFILE
;FILB ←← 4 ;OUTPUT FILE HAS BEEN SPECIFIED
;TEMPOB←←EXPRB!FILB ;any of these on means all switches are temporary only
SWITB ←← 10 ;A SWITCH HAS BEEN SEEN--NO "ONLY" SWITCHES PERMITTED NOW
;DATEB ←← 20 ;More that just one day's news is being considered.
NEGB ←← 40 ;"-" appeared in front of switch or selection number.
GOTEXT←← 4 ;FOUND EXTENSION IN FILE NAME (SEE FLSCAN BEFORE CHANGING GOTEXT)
GOTP ←← 100 ;FOUND PROJECT IN FILE NAME
GOTPN ←← 200 ;FOUND PROGRAMMER IN FILE NAME
TMP2B ←← 400 ;TMP FLAG USED IN: REDHED
QUOTE ←← TMP1B ;QUOTING FILENAME
STYB ←← 2000 ;GOT A STORY IN CORE
DISPLB←← 4000 ;NEED TO DISPLAY CURRENT FRAME OF STORY
HDRB ←← 10000 ;HAVE DISPLAYED HEADER LINE OF CURRENT STORY
PPSELB←← 20000 ;PIECE OF PAPER #1 IS CURRENTLY SELECTED
GOTMON←← GOTP ;MONTH SPECIFIED IN DATE
GOTYR ←← GOTPN ;YEAR SPECIFIED IN DATE
GOTDAY←← TMP1B ;DAY SPECIFIED IN DATE
IFILB ←← 40000 ;INPUT COMMAND FILE OPEN--READ NEXT COMMAND FROM THERE
IFILOB←← 100000 ;INPUT COMMAND FILE OPEN
;GAP
IFN DEBUG, <
MOVSYM: HRLZ W,JOBSYM↑ ;GET PTR TO SYMBOL TABLE
CAMN W,[SYM,,0] ;HAVE WE MOVED SYMBOLS YET?
EXIT ;YES
HRRI W,SYM ;ADDRESS OF NEW LOC FOR SYMBOL TABLE
HRRM W,JOBSYM ;MAKE NEW PTR TO SYMBOL TABLE
HLRE X,JOBSYM ;GET LENGTH OF SYMBOL TABLE
MOVN X,X ; AND MAKE IT POSITIVE
CAILE X,LSYM
HALT . ;SYMBOL TABLE TOO BIG TO FIT IN ARRAY
ADDI X,-1(W) ;CALCULATE ADDRESS OF LAST WORD
BLT W,(X) ;MOVE SYMBOL TABLE
OUTSTR [ASCIZ/OK/]
EXIT
JRST MOVSYM ;START AT SA-1 TO MOVE SYMBOL TABLE
>;END DEBUG
IFE DEBUG, <
EXIT 1,
>;END ¬DEBUG
GAP: RESET
MOVE P,[IOWD LPDL,PDL]
MOVEI F,DPYB!CHRONB!SHOWB!NYTB!APB ;CLEAR ALL FLAGS EXCEPT THESE
MOVEM F,PERM ;CLEAR ALL PERMANENT FLAGS BUT THESE
PUSHJ P,GETDPY
SKIPL LINTYP ;SKIP IF ON TELETYPE
PUSHJ P,DPYINI ;POSITION PP FOR DPY
PUSHJ P,APMESS ;TYPE OUT (OR DISPLAY) ANY MESSAGE TO ALL USERS
PUSHJ P,LSTINI ;INITIALIZE FREE STORY ELEMENT LIST
MOVEI A,INTRPT
MOVEM A,JOBAPR↑ ;SET UP ADDRESS OF INTERRUPT HANDLER
MOVSI A,INTTTI
INTENB A, ;ENABLE FOR INTERRUPTS ON ESC I
OUTSTR [ASCIZ /Type ? for help./]
GETPPN A, ;GET USER'S REAL PPN
MOVEM A,USRPPN
SETZM DATIN ;NO .DAT FILE IN CORE YET
DATE A, ;GET TODAY'S DATE IN SYSTEM DATE FORMAT
MOVEM A,SDATE1 ; MAKE IT BEGINNING
MOVEM A,SDATE2 ; AND ENDING DATE OF RANGE
MOVEM A,STODAY ; REMEMBER TODAY'S DATE
DAYCNT A, ;CONVERT TO DAYCNT FORMAT
MOVEM A,DATE1 ; BEGINNING DATE
MOVEM A,DATE2 ; ENDING DATE
MOVEM A,TODAY ; TODAY
PUSHJ P,DAY1ST ;FIND OUT OLDEST DAY OF NEWS AVAILABLE
SETOM TIME1 ;NO TIME LIMITS GIVEN
SETOM TIME2
; PUSHJ P,INFILI ;OPEN DEFAULT INPUT FILE IF IT EXISTS
SETZ A,
GETPRV A, ;GET PRIVILEGES
TLZ A,777776 ;CLEAR ALL BUT LUP
HLLZM A,ALLOK ;FLAG INDICATING WHAT SERVICES USER GETS
;MAIN
G←←.
MAIN0: MOVE P,[IOWD LPDL,PDL] ;MAKE SURE STACK POINTER IS INTACT
MAIN: INSKIP
JFCL
MOVEI A,DPYB
SKIPL LINTYP ;SKIP IF NOT DPY
TDNN A,PERM ;IN DPY MODE?
PUSHJ P,DPYEND ;NO (DPYEND ALWAYS SKIPS)
PUSHJ P,DPYINI ;YES
SETZM TMPOFF
MOVE A,[TMPOFF,,TMPOFF+1]
BLT A,NDATE2 ;CLEAR ALL NEW FLAG VALUES AND NEW DATES
SETOM NTIME1 ;CLEAR NEW TIME VALUES
SETOM NTIME2
TDZ F,[EXPRB!SWITB!TMP1B,,PERMSK];CLEAR SOME FLAGS
PUSHJ P,FREAD ;YES, READ COMMAND FROM FILE OR TTY
PUSHJ P,TOMCHK ;SEE IF TOMORROW HAS ARRIVED
PUSHJ P,GETCH ;get first input char
PUSHJ P,SWSCAN ;scan leading switches
PUSHJ P,XSCAN ;scan for keyw expr
PUSHJ P,SWSCAN ;and more switches
CAIE C,CR ;THAT SHOULD USE UP ENTIRE COMMAND
SYNERR SYNTAX ERROR ;SYNTAX ERROR IF NOT DOUBLE-BUCKY E
PUSHJ P,SETTIM ;SET UP DATES AND TIMES
MOVE A,PRMOFF
ANDCA A,PERM ;TURN OFF NEW PERMANENTLY OFF FLAGS
OR A,PRMON ;TURN ON NEW PERMANENTLY ON FLAGS
MOVEM A,PERM ;AND SAVE NEW PERMANENT FLAG VALUES
OR F,A ;SET UP TEMPORARY FLAGS FROM PERM VALUES
ANDCM F,TMPOFF ;TURN OFF TEMPORARILY OFF FLAGS
OR F,TMPON ;TURN ON TEMPORARILY ON FLAGS
TLNN F,EXPRB ;EXPRESSION TYPED?
JRST MAIN ;NO
PUSHJ P,MAKLST ;YES, CREATE NEW CURRENT STORY LIST
TRNE F,SHOWB ;WANT AUTOMATIC SHOWING?
PUSHJ P,SHOW ;YES
JRST MAIN
;LSTINI APMESS DPYINI DPYEND
;ROUTINE TO INITIALIZE STORY LIST SPACE, AND A FEW OTHER THINGS
LSTINI: SETZM STYLST+LLISTS ;PUT NULL PTR AT END OF LIST
MOVEI A,LLISTS ;VALUE OF LAST PTR
MOVEM A,STYLST-1(A) ;MAKE EACH ELEMENT POINT TO THE NEXT ONE
SOJG A,.-1
SETZM HEADIN ;NO HEADLINE STORY IN CORE
SETZM CURREN ;CLEAR CURRENT STORY LIST
SETZM PREVIO ; AND PREVIOUS STORY LIST
SETZM NCURR ;NO STORIES IN CURRENT LIST
SETZM NPREV ; OR IN PREV LIST
MOVEI A,1
MOVEM A,FCURR ;FIRST STORY IN MAIN LIST WILL BE #1
; MOVEM A,FPREV ;DON'T THINK WE NEED THIS
SETZM POLPNT ;NO EXPR SCANNED SUCCESSFULLY YET
SETZM SEEN ;NO STORIES SEEN YET
NODAT: SETZM DATEND ;TODAY'S .DAT FILE NEVER BEEN IN CORE YET
IFG NWIRES-1 <
MOVE A,[DATEND,,DATEND+1]
BLT A,DATEND+NWIRES-1
>
CPOPJ: POPJ P,
APMESS: POPJ P,
DPYINI: TLO F,PPSELB
PPSEL 1 ;SELECT PIECE OF PAPER #1
MOVE A,[BYTE (7)27,15,12,0,0 (1)1] ;DRAW ARROW
MOVEM A,ARRPRG+2
DPYSIZ 3002 ;DD & III--3 GLITCHES, 2 LINES PER GLITCH
SKIPG LINTYP ;SKIP IF III
JRST DPYIN0
DPYPOS -540 ;III
PGACT 777770 ;TURN OFF RAID'S POG
JRST DPYIN2
DPYIN0: DPYPOS -600 ;DD
DPYIN1: MOVE A,DDARRC
MOVEM A,ARRPRG
SKIPA A,DDARRW
DPYIN2: MOVE A,IIARRW
MOVEM A,ARRPRG+1
UPGIOT 3,ARRHDR ;DRAW ARROW IN MIDDLE OF SCREEN
POPJ P,
DPYEND: AOS (P) ;ALWAYS TAKE SKIP RETURN
TLZN F,PPSELB!HDRB
POPJ P,
SKIPE LINTYP ;SKIP IF ON DD
JRST DPYEN2
PPACT 0
MOVE A,[BYTE (7)40,15,12,0,0 (1)1] ;REPLACE ARROW WITH SPACE
MOVEM A,ARRPRG+2
PUSHJ P,DPYIN1 ;ERASE ARROW ON DD
UPGIOT DDEHDR ;ERASE WHOLE SCREEN
DPYEN2: DPYCLR
POPJ P,
;READ0 READ READY GETCH GETDPY
READ0A: PUSHJ P,FGET0 ;CLOSE COMMAND FILE
OUTSTR [ASCIZ/
MANUAL INTERRUPTION -- COMMAND FILE CLOSED
/]
READ0: OUTSTR [ASCIZ/
*KEY: /]
PUSHJ P,GETDAT ;IF NO TYPE-AHEAD, READ IN .DAT FILE
JFCL ;GETDAT MAY CALL REDDAT, WHICH MAY SKIP
READ: MOVE B,[POINT 7,TYBUF]
MOVEM B,TYPNT#
READ1: INCHWL C
CAME B,TYEND ;FILLED UP BUFFER YET?
IDPB C,B ;NO
CAIN C,CR
JRST READ4
CAIE C,LF
CAIN C,ALT
JRST READ5
TRNN C,600 ;ANY CONTROL BITS ON?
JRST READ1 ;NO, GET NEXT CHAR
JRST READ5
READ4: INCHWL 1(P) ;READ LF AFTER CR
READ5: MOVEM C,BRCHAR# ;SAVE ACTIVATION CHAR
CAMN B,TYEND ;FULL BUFFER?
JRST [ PUSHJ P,FREAD4 ;LINE TOO LONG--TYPE OUT TRUNCATED COMMAND
JRST GETDPY]
SETZ C,
IDPB C,B ;NULL BYTE MARKS END OF INPUT
IDPB C,B ;NULL BYTE MARKS END OF INPUT
GETDPY: SETOB C,LINTYP ;FIGURE OUT WHAT KIND OF TERMINAL USER IS ON
GETLIN C
AOJE C,CPOPJ ;IF DETACHED, ASSUME TELETYPE (LINTYP = -1)
TLNE C,20000
SETZM LINTYP ;0 FOR DD
JUMPG C,.+2
HRRZS LINTYP ;0,,-1 FOR III
SETO C,
CALLI C,400066
TLZE C,40000
TLZN C,1
JRST .+2
POPJ P,
XLIST
SETZM JOBSA↑
MOVE A,[140,,141]
SETZM -1(A)
MOVE B,[READY,,READY+1]
SETZM -1(B)
BLT B,@JOBREL↑
BLT A,.
OUTSTR .+2
EXIT
ASCIZ /
This program works only for local users
and must be started by monitor NS command./
LIST
READY: PUSH P,B ;ROUTINE TO GET ANSWER TO YES OR NO QUESTION
PUSH P,C
PUSH P,BRCHAR
MOVE B,[POINT 7,BUF2]
PUSHJ P,READ1
POP P,BRCHAR
POP P,C
POP P,B
LDB A,[POINT 7,BUF2,6]
CAIE A,"Y"
CAIN A,"y"
POPJ P, ;DIRECT RETURN FOR YES
AOS (P)
CAIE A,"?"
AOS (P) ;DOUBLE SKIP RETURN FOR NO
POPJ P, ;SINGLE SKIP RETURN FOR "?"
GETCH: ILDB C,TYPNT ;ROUTINE TO GET NEXT NON BLANK CHARACTER
GETCH1: CAIE C," "
CAIN C,TAB
JRST GETCH
POPJ P,
;SETSWT CLRSWT SWSCAN GETSWT FINDSW
SETSWT: HLRZ D,D ;GET BIT(S) TO SET OR CLR
TLZE F,NEGB ;SWITCH PRECEDED BY "-"?
JRST CLRSWT ;YES, CLEAR FLAG BIT(S)
TDNE D,TMPOFF ;ANY OF THESE BITS ALSO TO BE TURNED OFF?
JRST SWERR4 ;YES, ERRORRR
ORM D,TMPON ;TURN BITS ON IN TEMP FLAG WORD
TLNN F,EXPRB ;ANY EXPRESSION SEEN YET?
ORM D,PRMON ;NO, SWITCH IS PERMANENT
POPJ P,
CLRSWT: TDNE D,TMPON ;ANY OF THESE BITS ALSO TO BE TURNED ON?
JRST SWERR4 ;YES, ERRRORR
ORM D,TMPOFF ;TURN BITS ON (OFF) IN TEMP FLAG WORD
TLNN F,EXPRB ;ANY EXPRESSION SEEN YET?
ORM D,PRMOFF ;NO, SWITCH IS PERMANENT
POPJ P,
SWDO: PUSHJ P,(D) ;DO SWITCH THING, THEN LOOK FOR MORE SWITCHES
TLO F,SWITB
SWSCAN: PUSHJ P,GETCH1 ;GET FIRST NON-BLANK CHAR
CAIE C,"/" ;SWITCH COMING?
POPJ P, ;NOPE
MOVE A,TYPNT
MOVEM A,TTMS+1 ;SET UP TTYMES POINTER IN CASE OF ERROR
PUSHJ P,GETCH ;GET NEXT NON-BLANK CHAR
TLO F,NEGB
CAIE C,"-" ;SWITCH PRECEDED BY MINUS SIGN?
TLZA F,NEGB ;NO
PUSHJ P,GETCH ;YES, GET FIRST CHAR OF SWITCH
MOVE D,[-LSWIT,,SWNAMS];AOBJN PTR FOR FINDSW
PUSHJ P,FINDSW ;READ IN SWITCH AND LOCATE IN TABLE
JRST SWERR1 ;UNDEFINED
JRST SWERR2 ;AMBIGUOUS
SKIPL D,SWDSP-SWNAMS(D) ;PICK UP DISPATCH ADDRESS
JRST SWDO ;NOT AN "ONLY" SWITCH--DO IT IMMEDIATELY
TLNN D,SWARG ;DOES THIS SWITCH TAKE AN ARGUMENT?
CAIN C,CR ;NO, MUST BE FOLLOWED BY CR
TLNE F,EXPRB!SWITB
JRST SWERR3 ;"ONLY" SWITCH NOT ONLY THING
IOR F,PERM ;PICK UP PERMANENT SWITCH VALUES
PUSHJ P,(D) ;CARRY OUT SWITCH COMMAND
JRST MAIN0 ;DONE WITH CURRENT COMMAND
SWERR1: OUTSTR SORRY
OUTSTR [ASCIZ/UNDEFINED SWITCH/]
JRST SWERR
SWERR2: OUTSTR SORRY
OUTSTR [ASCIZ/AMBIGUOUS SWITCH/]
JRST SWERR
SWERR3: OUTSTR SORRY
OUTSTR [ASCIZ/COMMAND SWITCH MUST OCCUR ALONE/]
JRST SWERR
SWERR4: OUTSTR SORRY
OUTSTR [ASCIZ/MODE SWITCH OCCURS IN CONTRADICTORY SENSES/]
JRST SWERR
SWERR5: OUTSTR SORRY
OUTSTR [ASCIZ/SWITCH HAS NO NEGATIVE SENSE/]
SWERR: MOVEI C,"/"
SERR: OUTSTR [ASCIZ/.
/]
OUTCHR C
MOVEI E,TTMS
TTYMES E,
JFCL
OUTSTR CRLF
JRST MAIN0
GETSWT: SETZM BUF2 ;THIS WILL HOLD THE SWITCH IN SIXBIT
SETZM BUF2+1 ;THIS WILL HOLD A MASK
SETO A,
SKIPA B,[POINT 6,BUF2];collect first 6 chars of switch in sixbit in BUF2
GETSW1: ILDB C,TYPNT
CAIL C,"A"
CAILE C,"z"
AOJA B,GETSWX ;not a letter
CAIG C,"Z"
ORI C,40 ;convert to lower case for storing sixbit
CAIGE C,"a"
AOJA B,GETSWX ;not a letter
TLNE B,770000 ;already got 6 chars?
IDPB C,B ;no
JRST GETSW1
IDPB A,B ;FILL OUT MASK WORD WITH -1'S
GETSWX: TLNE B,770000 ;AT END OF WORD?
JRST .-2 ;NO
JRST GETCH1 ;NEXT NON-BLANK CHAR
;ROUTINE TO SEARCH COMMAND TABLE FOR COMMAND
;CALL WITH FIRST CHAR OF COMMAND IN C, PTR TO REST IN TYPNT, AOBJN PTR TO TABLE IN D
;CLOBBERS A,B; LEAVES NEXT NON-BLANK CHAR IN C.
;3 DIFFERENT RETURNS:
; <undefined command>
; <ambiguous command>
; <unique command found, ptr to command returned in D>
FINDS0: PUSHJ P,GETCH ;ENTRY POINT WHEN DON'T HAVE FIRST CHAR YET
FINDSW: PUSHJ P,GETSWT ;READ IN SWITCH
SKIPN A,BUF2 ;PICK UP FIRST 6 CHARS OF COMMAND
POPJ P, ;null command is undefined
SETOM SWFIND# ;-1 MEANS NOT FOUND IN TABLE YET, 0 FOUND ONCE, ETC
FINDS1: SETCM B,BUF2+1 ;PICK UP MASK
AND B,(D)
CAMN A,B ;MATCH?
JRST [MOVEM D,SWSAV ;YES
AOS SWFIND ;COUNT ANOTHER MATCH
JRST .+1]
AOBJN D,FINDS1
HRRZ D,SWSAV#
SKIPL A,SWFIND ;UNDEFINED?
AOS (P) ;NO, SKIP AT LEAST 1
JUMPE A,CPOPJ1 ;ZERO => UNIQUE => DOUBLE SKIP
POPJ P, ;NO AMBIGUOUS, SKIP RETURN
;FROM TO ON DATES PDATE RDDATE TOMCHK AFTER BEFORE RDTIME PTIME
RDTIM2: MOVE A,B
CAIGE A,=100 ;BOTH HOURS & MINS GIVEN?
TDZA B,B ;NO, ONLY HOURS, CLEAR MINUTES
IDIVI A,=100 ;HOURS INTO A, MINUTES INTO B
JRST RDTIM1
RDTIME: PUSHJ P,GETCH1
CAIL C,"0"
CAILE C,"9"
JRST BDTIME ;TIME DOESN'T START WITH A DIGIT
PUSHJ P,RDNBR0 ;READ HOURS
CAIE C,":"
JRST RDTIM2 ;ALREADY GOT HOURS & MINUTES
PUSH P,B
PUSHJ P,INNBR0 ;READ MINUTES
POP P,A ;RETRIEVE HOURS
RDTIM1: CAIL B,=60 ;REASONABLE NUMBER OF MINUTES?
JRST BDTIME ;NO
IMULI A,=60 ;CONVERT HOURS TO MINUTES
ADD A,B ;ADD IN MINUTES
CAIN A,=12*=60 ;1200 (OR 12) GIVEN?
JRST RDNOON ;YES, DON'T ALLOW 12AM OR 12PM, ONLY 12N OR 12M
CAIE C,"a"
CAIN C,"A" ;"AM"?
JRST RDTIM3 ;YES
CAIE C,"p"
CAIN C,"P" ;"PM"?
JRST .+2 ;YES
JRST RDTIM4
ADDI A,=12*=60 ;MAKE TIME INTO AFTERNOON
RDTIM3: ILDB C,TYPNT ;skip A or P in AM or PM
CAIE C,"M"
CAIN C,"m"
RDTIM6: ILDB C,TYPNT ;SKIP THE m (AS IN "pm")
RDTIM4: CAIG A,=24*=60 ;LEGAL TIME?
JRST GETCH1 ;YES, GET NEXT NON-BLANK CHAR
BDTIME: OUTSTR SORRY
OUTSTR [ASCIZ /IMPROPER TIME/]
JRST SWERR
RDNOON:
REPEAT 0,< ;NOON IS JUST 12, 1200 OR 12:00. MIDNIGHT IS 0, 24, 2400 OR 24:00.
CAIE C,"N"
CAIN C,"n"
JRST RDTIM6 ;NOON GIVEN
CAIE C,"M"
CAIN C,"m"
JRST [MOVEI A,=24*=60 ;MIDNIGHT GIVEN
JRST GETCH1]
>;END REPEAT 0
CAIE C,"A"
CAIN C,"a"
JRST RDTIM5 ;12AM IS ILLEGAL (UNDEFINED TIME)
CAIE C,"P"
CAIN C,"p"
JRST RDTIM5 ;12PM IS ILLEGAL
JRST GETCH1 ;JUST PLAIN 12 IS OK (NOON)
RDTIM5: OUTSTR [ASCIZ/NOON IS "12" OR "1200". MIDNIGHT IS "0000", "24" OR "2400".
/]
JRST BDTIME
AFTER: SKIPL NTIME1
JRST BDTIME
PUSHJ P,RDTIME
MOVEM A,NTIME1
POPJ P,
BEFORE: SKIPL NTIME2
JRST BDTIME
PUSHJ P,RDTIME
MOVEM A,NTIME2
POPJ P,
DATES: PUSHJ P,DATES0
JRST DAY1S2 ;PRINT DATE OF OLDEST AVAILABLE NEWS
DATES0: MOVE A,TIME1
MOVE B,SDATE1
PUSHJ P,PTMDAT ;PRINT BEGINNING TIME AND DATE
MOVE B,SDATE2
SKIPGE TIME1
SKIPL TIME2 ;EITHER BEGINNING OR ENDING TIME GIVEN?
JRST DATES1 ;YES
CAMN B,SDATE1
POPJ P, ;ENDING DATE SAME AS BEGINNING
DATES1: MOVE A,TIME2
OUTSTR [ASCIZ / thru /];PRINT ENDING TIME AND DATE, FALLING INTO PTMDAT
PTMDAT: JUMPL A,PDATE ;JUMP IF NO TIME GIVEN
PUSH P,B ;SAVE DATE
PUSHJ P,PTIME ;PRINT ADJUSTED TIME
POP P,B
PUSHJ P,CHGDAY ;ADJUST DATE
JRST PDATE ;PRINT DATE
PTIM0: OUTSTR [ASCIZ /0000 /]
POPJ P,
PTIM4: OUTSTR [ASCIZ /1200 /]
POPJ P,
PTIM5: OUTSTR [ASCIZ /2400 /]
POPJ P,
PTIME: PUSHJ P,PDT ;CONVERT TO PACIFIC TIME (DATE OFFSET INTO D)
JUMPE A,PTIM0 ;0000
CAIN A,=24*=60
JRST PTIM5 ;2400
CAIN A,=12*=60
JRST PTIM4 ;1200
IDIVI A,=60 ;HOURS INTO A, MINUTES INTO B
PUSH P,B
CAIGE A,=12 ;PM?
JRST PTIM1
HRRZS -1(P) ;FLAG AS PM
CAIE A,=12
SUBI A,=12
PTIM1: PUSHJ P,DECOUT ;PRINT HOURS
POP P,A
JUMPE A,PTIM2
OUTCHR [":"]
IDIVI A,=10
ADDI A,"0"
OUTCHR A ;PRINT FIRST MINUTES DIGIT
ADDI B,"0"
OUTCHR B ;SECOND MINUTES DIGIT
PTIM2: HLLZ A,(P) ;RETRIEVE AM FLAG
JUMPE A,PTIM3 ;JUMP IF PM
OUTSTR [ASCIZ /am /]
POPJ P,
PTIM3: OUTSTR [ASCIZ /pm /]
POPJ P,
PDATE: MOVE D,B ;COPY DATE
DAYCNT D,
IDIVI D,7 ;FIND DAY OF WEEK
ASH E,1 ;MULT BY 2 SINCE EACH DAY IS TWO WORDS LONG
OUTSTR WEEK(E)
OUTSTR [ASCIZ/, /]
IDIVI B,=31
PUSH P,B
MOVEI A,1(C) ;DAY OF MONTH
PUSHJ P,DECOUT
POP P,A
IDIVI A,=12
OUTCHR ["-"]
OUTSTR MONTH(B)
ADDI A,=64
JRST DECOUT
ON: PUSHJ P,FROM
JRST TO1
FROM: PUSHJ P,RDDATE
MOVEM A,NDATE1
POPJ P,
TO: PUSHJ P,RDDATE
TO1:
TLNN F,GOTMON
JRST TO2
TLNN F,GOTDAY
ADDI A,=30
MOVEM A,NDATE2
POPJ P,
TO2: TLNE F,GOTYR
ADDI A,=12*=31 - 1
MOVEM A,NDATE2
POPJ P,
RDDATE: TLZ F,GOTMON!GOTDAY!GOTYR
SETZ A,
PUSHJ P,GETCH1 ;NEXT NON-BLANK CHAR
RDDA0: CAIL C,"0"
CAILE C,"9"
JRST RDMON ;MUST BE MONTH
PUSHJ P,RDNBR ;GET DATE OR YEAR
SOJL B,BDDATE
CAIL B,=31 ;DAY OF MONTH?
JRST RDYEAR ;NO--MUST BE YEAR
TLOE F,GOTDAY ;YES
JRST BDDATE
JRST RDDA9
RDYEAR: SUBI B,=63 ;WE ALREADY SUBTRACTED 1
JUMPL B,BDDATE
CAILE B,=99
SUBI B,=1900 ;YEAR GIVEN LIKE 1974
JUMPL B,BDDATE
TLON F,GOTYR
CAILE B,=35
JRST BDDATE
IMULI B,=12*=31
JRST RDDA9
RDMON: PUSH P,A
MOVE D,[-(=12+7+2),,MONTH6];SET UP AOBJN PTR FOR FINDSW
PUSHJ P,FINDSW ;FIND MONTH OR DAY OF WEEK TYPED
JRST BDDATE ;UNDEFINED DATE
JRST BDDATE ;AMBIGUOUS DATE
POP P,A
MOVEI B,-MONTH6(D) ;CALCULATE POSITION IN TABLE
CAIL B,=12 ;MONTH?
JRST RDWEEK ;NO--DAY OF WEEK
TLOE F,GOTMON ;YES
JRST BDDATE ;TWO MONTHS MENTIONED IN SAME DATE
IMULI B,=31
RDDA9: ADDI A,(B)
CAIE C,"-" ;MORE DATE COMING?
JRST RDDA7 ;NO
ILDB C,TYPNT ;YES
JRST RDDA0
RDDA7: TLNE F,GOTMON
JRST RDDA71 ;MONTH GIVEN
TLNN F,GOTYR ;NO MONTH GIVEN
JRST RDDA72 ;NO MONTH, NO YEAR
TLNE F,GOTDAY ;NO MONTH, YEAR
JRST BDDATE ;NO MONTH, YEAR, DAY
JRST GETCH1 ;YEAR ONLY
RDDA71: TLNE F,GOTYR
JRST GETCH1 ;MONTH, YEAR
MOVE D,STODAY
IDIVI D,=31*=12
RDDA73: IMULI D,=31*=12
ADD A,D
JRST GETCH1
RDDA72: TLNN F,GOTDAY
JRST BDDATE ;NO NUTHIN'
MOVE D,STODAY
IDIVI D,=31
IDIVI D,=12
IMULI E,=31
ADD A,E
JRST RDDA73
RDWEEK: SUBI B,=12
TLOE F,GOTDAY!GOTYR!GOTMON
JRST BDDATE
MOVE A,STODAY
CAIN B,=7 ;TODAY?
POPJ P, ;YES
CAIN B,=8 ;YESTERDAY?
JRST YESTER ;YES
MOVE D,TODAY
IDIVI D,7
SUBI B,(E)
JUMPL B,.+2
SUBI B,7
SKIPA D,B ;DATE DIFFERENCE INTO D
YESTER: SETO D,
MOVE B,STODAY ;TODAY'S DATE
PUSHJ P,CHGDAY ;FIND DATE WANTED
MOVEI A,(B) ;RETURN DATE IN A
JRST GETCH1
BDDATE: OUTSTR SORRY
OUTSTR [ASCIZ /BAD DATE/]
JRST SWERR
TOMCHK: ACCTIM D, ;GET CURRENT DATE AND TIME
HLRZ B,D ;DATE INTO E
CAMLE B,STODAY ;DAY CHANGED YET?
JRST TOMCH1 ;YES
HRRZ D,D ;TIME IN SECS
CAIGE D,APMIDNIGHT+=10*=60 ;10 MINS INTO NEXT DAY AP STYLE?
POPJ P, ;NO
MOVEI D,1 ;ADD ONE DAY TO SYSTEM DATE
PUSHJ P,CHGDAY ;ADJUST DATE
TOMCH1: MOVEM B,STODAY ;REMEMBER NEW DATE
DAYCNT B,
EXCH B,TODAY ; IN BOTH FORMATS
CAMN B,DATE2 ;DATE RANGE END TODAY?
SKIPL TIME2 ;YES, ANY ENDING TIME GIVEN?
JRST NODAT ;YES
MOVE B,STODAY ;NO, EXTEND DATE RANGE TO TOMORROW
MOVEM B,SDATE2
MOVE B,TODAY
MOVEM B,DATE2
JRST NODAT ;NEW TODAY'S DATA NEVER HAS BEEN READ IN (CLEAR DATEND)
;UUCODE INTRPT DECOUT DPYNUM OCTOUT CMDXIT
CMDXIT: PUSHJ P,XIT ;YES
JRST MAIN0
NOCR: OUTSTR [ASCIZ /COMMAND MUST END WITH CARRIAGE RETURN./]
JRST MAIN0
UUCODE: 0
PUSH P,A
HLRZ A,40 ;PICK UP LH OF UUO
ANDI A,777000 ;MASK OUT ALL BUT OPCODE
CAIE A,(<UERROR>)
JRST UUCOD1 ;START UP ERROR[NS,SYS]
MOVE A,BRCHAR
CAIE A,705 ;DOUBLE-BUCKY E?
CAIN A,745 ;DOUBLE-BUCKY e?
JRST CMDXIT ;YES
CAIE A,505 ;META E?
CAIN A,545 ;META e?
PUSHJ P,TRYDDT ;YES
OUTSTR SORRY ;SAY WE'RE "SORRY -- "
TLZ F,IFILB ;DON'T READ FROM FILE AUTOMATICALLY
CAIE A,CR
JRST NOCR ;COMMAND LINE NOT ENDED WITH CR
OUTSTR @40 ;ERROR MESSAGE
OUTSTR CRLF
LDB A,[POINT 4,40,12] ;PICK UP AC FIELD OF UUO
JUMPN A,MAIN0 ;IF NON-ZERO, DON'T TYPE OUT REST OF INPUT LINE
OUTCHR C ;CURRENT CHAR IN SCAN
MOVE A,TYPNT
MOVEM A,TTMS+1
MOVEI A,TTMS
TTYMES A, ;TYPE OUT REST OF COMMAND, UP TO CR
OUTSTR [ASCIZ/ ... OOPS .../]
OUTCHR [LF]
JRST MAIN0
UUCOD1: PUSH P,B
PUSH P,16
HRRZ B,USRPPN
CAIN B,' ME'
JRST UUCOD2
MOVSI A,'NS ' ;PASS PROGRAM NAME IN AC 1
MOVE B,40 ;PASS UUO IN AC 2
MOVEI 16,ERRBK
SWAP 16, ;START UP ERROR[NS,SYS]
UUCOD2: RESET
OUTSTR [ASCIZ /
FATAL ERROR #/]
HRRZ A,40
PUSHJ P,OCTOUT
POP P,16
POP P,B
POP P,A
EXIT
OCTOUT: IDIVI A,=8
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,OCTOUT
HLRZ A,(P)
ADDI A,"0"
OUTCHR A
POPJ P,
INTRPT: MOVS A,JOBCNI↑
CAIN A,INTTTI
SETOM ESCIFG ;NOTE THAT USER TYPED ESC I
DISMIS ;INTERRUPT HANDLER
DECOUT: MOVE R,[POINT 7,BUF2]
PUSHJ P,DECOU1
IDPB A,R
OUTSTR BUF2
POPJ P,
DPYNUM: MOVEI B,1 ;PUT DISPLAY TEXT FOR NUMBER IN A INTO WORD AT (R)
MOVEM B,(R)
HRLI R,440700 ;MAKE BYTE PTR OUT OF R
CAIL A,=9999
MOVEI A,=9999 ;FOUR DIGITS MAX
;FALL INTO DECOU1
DECOU1: IDIVI A,=10
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,DECOU1
HLRZ B,(P)
ADDI B,60
IDPB B,R
POPJ P,
;DELALL DELNTF GETNTF NOTIFY DSPALL DELRQS
DELALL: ;delete all notification requests
DELNTF: ;delete all notifications
GETNTF: ;make current story list from notifications
NOTIFY: ;make current story list from notifications and allow deleting notes
DSPALL: ;display all notification requests
DELRQS: ;allow selective deleting of requests
OUTSTR [ASCIZ /The feature you requested is not in service at this time.
/]
POPJ P,
;XSCAN TERM FACTOR PRIMAR
XSCAN: CAIN C,CR
POPJ P, ;END OF COMMAND
TLO F,EXPRB ;KEYWORD EXPR FOUND
CAIN C,"*"
JRST CTIMES ;expression starts with "*", continue prev expr
CAIN C,"-"
JRST CMINUS ;a poor grade
CAIN C,"+"
JRST CPLUS ;little better grade
MOVEI A,POLISH-1
MOVEM A,POLX
SETZM POLISH
MOVE A,[POLISH,,POLISH+1]
BLT A,POLEND ;CLEAR POLISH ARRAY
SETZM POLPNT ;NO PREVIOUS LEGAL EXPRESSION NOW
PUSHJ P,TERM ;SCAN EXPRESSION
XSCAN1: MOVE A,POLX
MOVEM A,POLPNT ;SAVE PTR TO END OF LEGAL EXPR
POPJ P,
CMINUS: PUSH P,[XMINUS]
JRST CEXPR
CPLUS: PUSH P,[XPLUS]
JRST CEXPR
CTIMES: PUSH P,[XTIMES]
CEXPR: SKIPN A,POLPNT
SPCERR THERE IS NO PREVIOUS VALID EXPRESSION TO CONTINUE
MOVEM A,POLX
PUSHJ P,GETCH ;SKIP OVER OPERATOR
PUSHJ P,TERM ;SCAN EXPRESSION
POP P,A
PUSHJ P,SAVPOL ;PUT OPERATION INTO POLISH
JRST XSCAN1
TERM: PUSHJ P,FACTOR
TERM2: CAIN C,"+"
JRST PLUS
CAIE C,"-"
POPJ P,
MINUS: PUSHJ P,GETCH
PUSHJ P,FACTOR
MOVE A,[XMINUS]
PUSHJ P,SAVPOL
JRST TERM2
PLUS: PUSHJ P,GETCH
PUSHJ P,FACTOR
MOVE A,[XPLUS]
PUSHJ P,SAVPOL
JRST TERM2
FACTOR: PUSHJ P,PRIMAR
FACT2:
IFN MULTWD <
CAIL C,"A"
JRST FACT4 ;must be a letter (or illegal). assume mult word key
>
CAIE C,"*"
POPJ P,
PUSHJ P,GETCH
FACT4: PUSHJ P,PRIMAR
MOVE A,[XTIMES]
PUSHJ P,SAVPOL
JRST FACT2
PRIMAR: CAIE C,"("
JRST GETWD
PUSHJ P,GETCH
PUSHJ P,TERM
CAIN C,")"
JRST GETCH
SYNERR MISSING RIGHT PARENTHESIS
;GETWD GETSEQ GETREC COMCHK SUFCHK
GETWD: CAIN C,"#" ;SPECIFIC SEQUENCE NUMBER(S)?
JRST GETSEQ ;yes
CAILE C,"9" ;NUMBER COMING?
JRST GETWD0 ;NO
CAIL C,"0"
JRST GETREC ;YES, MOST-RECENT-STORIES TERM HERE
GETWD0: MOVE Q,POLX ;POLX CONTAINS POINTER TO LAST WORD IN POLISH
HRLI Q,000500 ;MAKE A BYTE POINTER
MOVEM Q,POLX
SETZ Z, ;COUNT CHARS IN KEYWORD WITH Z
GETWD1: CAIL C,"A"
CAILE C,"z"
JRST GETWDX ;NOT A LETTER
CAIG C,"Z"
JRST .+3
CAIGE C,"a"
JRST GETWDX ;NOT A LETTER
IDPB C,Q ;LETTER--PART OF KEYWORD
CAML Q,[370500,,POLEND]
SYNERR EXPRESSION TOO LONG
ILDB C,TYPNT
AOJA Z,GETWD1 ;COUNT A LETTER AND PROCESS THE NEXT
GETWDX: CAMN Q,POLX
JRST GETHLP ;SEE IF NEEDS HELP
COMCHK: MOVE X,(Q) ;LAST 7 CHARS OF KEYWORD
;the next instruction is a bit of a kludge. it should never be permitted to skip
SKIPE DATIN ;DON'T DO COMMON WORD CHECK IF NO .DAT FILE AROUND
CAILE Z,7 ;NO COMMON WORDS HAVE MORE THAN 7 CHARS
JRST SUFCHK ;DO SUFFIX REMOVAL
LDB A,[POINT 10,X,11] ;PICK UP INDEX BITS FROM KEYWORD
HLRZ B,DATA+INDLOC(A);PICK UP POINTER INTO COMMON WORDS
CAMLE X,DATA+COMLOC(B);COMPARE KEYWORD AND COMMON WORD
AOJA B,.-1 ;NEXT COMMON WORD
CAME X,DATA+COMLOC(B)
JRST SUFCHK ;NOT COMMON WORD--DO SUFFIX REMOVAL
OUTSTR [ASCIZ /COMMON WORD ASSUMED PRESENT IN ALL STORIES: /]
MOVE B,X
PUSHJ P,FIVOUT
OUTSTR CRLF
MOVEI A,-1 ;COMMON WORD, KLUDGE UP A "#" TO REPLACE COMMON WORD
JRST GETSE1
;GOT WHOLE WORD--NOW FOR SUFFIX REMOVAL
SUFCHK: MOVEI Y,LSUFF ;NBR OF SUFFIXES TO CHECK FOR IN LONG KEYWORDS
CAIG Z,6
XCT SUFNBR-1(Z) ;PICK UP NUMBER OF SUFFIXES TO CHECK (SHORT WORDS)
MOVE A,Z ;LENGTH OF KEYWORD
IDIVI A,7 ;NUMBER OF REAL CHARS IN LAST 7
XCT SUFLSH(B) ;RIGHT JUSTIFY SUFFIX
SUFCH1: MOVE A,X ;COPY KEYWORD ENDING
XOR A,SUFF-1(Y) ;XOR WITH ACTUAL SUFFIX
TDNE A,SUFFM-1(Y) ;ALL MASKED BITS MATCH?
SOJG Y,SUFCH1 ;NO
JUMPG Y,SUFREM ;YES, OR NO MORE SUFFIXES
SUFCH2: LDB A,[POINT 6,X,30];CHECK FOR ENDING IN DOUBLED LETTER
XORI A,(X) ;XOR LAST TWO LETTERS TOGETHER
TRNN A,76 ;MATCH?
JRST SUFRE0 ;YES, REMOVE SECOND COPY OF DOUBLED LETTER
;NOW WE HAVE REMOVED ALL POSSIBLE SUFFIXES
NOSUFF: TDZA A,A ;FILL OUT WORD WITH NULLS
IDPB A,Q
TLNE Q,760000
JRST .-2
MOVEI A,1
ORM A,(Q) ;MARK END OF KEYWORD
MOVEM Q,POLX
JRST GETCH1
SUFRE0: MOVEI Y,1 ;REMOVE LAST LETTER
SUFREM: MOVE A,SUFFN-1(Y) ;GET LENGTH OF SUFFIX FOUND
SUBI Z,(A) ;NEW KEYWORD LENGTH
ADD Q,SUFBYT-1(A) ;BACK UP BYTE POINTER (A) BYTES
TLNE Q,400000 ;OVERFLOW POSITION FIELD?
SUB Q,[430000,,1] ;YES, RESET POSITION FIELD AND BACKUP ADDRESS FIELD
SETZM 1(Q) ;ZERO OUT NEXT WORD IN CASE WE BACKED UP A WORD
SKIPGE SUFF-1(Y) ;DO WE REMOVE DOUBLED LETTERS PRECEDING THIS SUFFIX?
CAIG Z,3 ;YES, MUST BE AT LEAST 4 LETTERS LEFT TO DO THAT
JRST NOSUFF ;DONE WITH SUFFIXES FOR THIS WORD
LSH X,@SUFDBL-1(A) ;REJUSTIFY WORD (A IS LENGTH OF SUFFIX REMOVED)
JRST SUFCH2 ;LOOK FOR DOUBLED LETTER
SUFDBL: 0,,-5
0,,-=10
0,,-=15
0,,-=20
SUFBYT: 050000,,0 ;ONE BYTE
120000,,0 ;TWO
170000,,0 ;THREE
240000,,0 ;FOUR
SUFNBR: JRST NOSUFF ;KEYWORD TOO SHORT
JRST NOSUFF
JRST NOSUFF
MOVEI Y,LSUFF1 ;NUMBER OF SUFFIXES OF LENGTH 1
MOVEI Y,LSUFF2 ;NUMBER OF SUFFIXES OF LENGTH 2 OR LESS
MOVEI Y,LSUFF3 ;NUMBER OF SUFFIXES OF LENGTH 3 OR LESS
SUFLSH: JFCL ;ALREADY JUSTIFIED
PUSHJ P,SUF2WD ;1 CHAR, GET 7 MORE
PUSHJ P,SUF2WD ;2 CHARS, GET 7 MORE
PUSHJ P,SUF2WD ;3 CHARS, GET 7 MORE
LSH X,-=15 ;4 CHARS, MOVE RIGHT 3 BYTES
LSH X,-=10 ;5 CHARS, MOVE RIGHT 2 BYTES
LSH X,-5 ;6 CHARS, MOVE RIGHT 1 BYTE
SUF2WD: MOVE W,-1(Q)
LSH W,-1
LSHC W,@SUFLSC-1(B) ;B IS 1, 2, OR 3
POPJ P,
SUFLSC: 0,,-=30
0,,-=25
0,,-=20
DEFINE SUFFIX(S,A,B,C,D)
{BYTE (1)S (14)0 (5)"A","B","C","D"}
;HERE WE HAVE THE ACTUAL SUFFIXES WE WILL REMOVE
SUFF:
SUFFIX(0,,,,Y) ;FIRST SUFFIX MUST BE OF TYPE 0
SUFFIX(1,,,,S)
SUFFIX(1,,,,E)
LSUFF1←←.-SUFF
SUFFIX(0,,,Y,S)
SUFFIX(0,,,L,Y)
SUFFIX(0,,,I,E)
SUFFIX(1,,,E,D)
SUFFIX(1,,,E,S)
LSUFF2←←.-SUFF
SUFFIX(0,,S,L,Y)
SUFFIX(0,,E,L,Y)
SUFFIX(0,,I,E,S)
SUFFIX(0,,I,E,D)
SUFFIX(1,,I,N,G)
LSUFF3←←.-SUFF
SUFFIX(0,Y,I,N,G)
LSUFF←←.-SUFF
;LENGTHS OF SUFFIXES
SUFFN: REPEAT LSUFF1 ,{1}
REPEAT LSUFF2-LSUFF1,{2}
REPEAT LSUFF3-LSUFF2,{3}
REPEAT LSUFF -LSUFF3,{4}
;MASKS FOR SUFFIXES
SUFFM: REPEAT LSUFF1 ,{BYTE (30)0(5)77}
REPEAT LSUFF2-LSUFF1,{BYTE (25)0(10)7777}
REPEAT LSUFF3-LSUFF2,{BYTE (20)0(15)777777}
REPEAT LSUFF -LSUFF3,{BYTE (15)0(20)77777777}
GETHLP: ANDI C,177
CAIE C,"?"
SYNERR MISSING KEYWORD
PUSHJ P,HELP
JRST MAIN0
GETSEQ: PUSHJ P,GETCH ;NEXT NON-BLANK CHARACTER
MOVEI A,-1 ;USE RANGE OF 0:777777 IF NO NUMBER PRESENT
CAIL C,"0"
CAILE C,"9"
JRST GETSE1
PUSHJ P,RDNBR ;EVALUATE SEQ NBR
HRLZ A,B ;PUT BEGINNING SEQ RANGE NUMBER IN LH OF A
CAIN C,":" ;RANGE OF SEQS?
PUSHJ P,INNBR ;YES, EVALUATE ENDING SEQ NBR
HRR A,B ;PUT ENDING SEQ RANGE NUMBER IN RH OF A
GETSE1: MOVE B,[XSEQ] ;CODE INDICATING HAVE SEQ NBR RANGE TERM
GETSE2: HRRZ Q,POLX
PUSH Q,B ;PUSH CODE INTO EXPR
CAML Q,[1,,POLEND]
SYNERR EXPRESSION TOO LONG
PUSH Q,A ;PUT DATA INTO EXPR
MOVEM Q,POLX ;SAVE PTR TO END OF EXPR
JRST GETCH1
GETREC: PUSHJ P,RDNBR ;GET NUMBER TYPED
MOVE A,B ;NUMBER INTO A
MOVE B,[XREC] ;GET CODE FOR RECENT-STORIES TERM
JRST GETSE2
;INNBR RDNBR SAVPOL DAY1ST INNBR0 RDNBR0
INNBR0: ILDB C,TYPNT
RDNBR0: SETZ B, ;B WILL HOLD THE VALUE OF THE NUMBER BEING READ
RDNBR1: CAIG C,"9" ;GOT A DIGIT?
CAIGE C,"0"
POPJ P, ;NO
IMULI B,=10 ;DECIMAL NUMBER
ADDI B,-60(C) ;CURRENT DIGIT
ILDB C,TYPNT
JRST RDNBR1
INNBR: ILDB C,TYPNT
RDNBR: PUSHJ P,RDNBR0
JRST GETCH1 ;GET NEXT NON-BLANK CHAR
SAVPOL: AOS Q,POLX
MOVEM A,(Q)
MOVEI B,(Q)
CAIL B,POLEND
SYNERR EXPRESSION TOO LONG
POPJ P,
DAY1ST: SETZM SFSTDA ;ASSUME NO LEGAL DATE
OPEN DAT,DSK17
UFATAL 502 ;;;CANT OPEN DSK
MOVE A,[DDFILE,,W]
BLT A,Z
LOOKUP DAT,W
POPJ P,
IN DAT,DDCMD ;READ DATE00.DAT FILE
JRST .+2
POPJ P,
MOVE B,DATE00+NWIRES-1 ;PICK UP DATE FOR LAST WIRE
MOVEI A,NWIRES-2 ;NUMBER OF NEXT TO LAST WIRE
CAMLE B,DATE00(A) ;THIS DATE EARLIEST SO FAR?
MOVE B,DATE00(A) ;YES, USE IT
SOJGE A,.-2 ;CHECK NEXT WIRE
CAMGE B,STODAY ;SHOULD BE BEFORE TODAY
CAIGE B,MAY13 ; AND ON OR AFTER 13-MAY-74
POPJ P, ;UNREASONABLE DATE IN DDFILE
MOVEM B,SFSTDA
DAY1S2: SKIPG B,SFSTDA
POPJ P,
OUTSTR [ASCIZ/
Some news available back to: /]
JRST PDATE ;PRINT BEGINNING DATE
;EXCHAN TELLSW SIXOUT TYPESW UPDATE UNSEEN SETFRM SIXTYP
EXCHAN: SKIPN A,NPREV
JRST EXCH1
EXCH A,NCURR
MOVEM A,NPREV
MOVE A,FPREV
EXCH A,FCURR ;INTERCHANGE NUMBERS OF FIRST STORIES
MOVEM A,FPREV
MOVE A,CURREN ;INTERCHANGE CURRENT AND PREVIOUS STORY LISTS
EXCH A,PREVIO
MOVEM A,CURREN
SETZM HEADIN ;NO HEADLINE STORY IN CORE
JRST COUNT ;PRINT NUMBER OF STORIES IN NEW CURRENT LIST
EXCH1: OUTSTR [ASCIZ/Null old list. No exchange done./]
POPJ P,
TELLSW: MOVEI E,LSWIT-1
MOVEI C,"-"
MOVEI D,"/"
MOVE Q,[POINT 7,BUF2]
TELLS0: HLRZ A,SWDSP(E)
TRNN A,PERMSK ;ANY FLAG BITS ON IN DISPATCH TABLE ENTRY?
JRST TELLS1 ;NO
IDPB D,Q ;YES, PUT / IN OUTPUT
TDNN A,PERM ;IS THIS BIT ON IN PERMANENT FLAG WORD?
IDPB C,Q ;NO, PRECEDE SWITCH WITH "-"
MOVE B,SWNAMS(E) ;PICK UP SIXBIT NAME OF SWITCH
PUSHJ P,SIXOUT
TELLS1: SOJGE E,TELLS0
TELLS2: SETZ A,
IDPB A,Q
OUTSTR BUF2
POPJ P,
SIXTYP: MOVE Q,[POINT 7,BUF2]
PUSHJ P,SIXOUT
JRST TELLS2
SIXOUT: MOVEI R,6
SIXOU1: SETZ A,
LSHC A,6
ADDI A,40
IDPB A,Q
JUMPE B,.+2
SOJG R,SIXOU1
POPJ P,
HELP0: HRRZ A,SWDSP(E)
MOVE B,SWNAMS(E)
PUSHJ P,SIXOUT
CAIG E,(D)
POPJ P,
IDPB C,Q
HELP0A: SOJA E,HELP0
TYPESW: MOVE Q,[POINT 7,BUF2]
MOVEI C,","
MOVEI R,[ASCIZ /Mode switches: /]
PUSHJ P,TYPSTR
MOVEI E,LSWIT
MOVEI D,LDATE
PUSHJ P,HELP0A
MOVEI R,[ASCIZ /
Date switches: /]
PUSHJ P,TYPSTR
MOVEI D,LONLY
PUSHJ P,HELP0A
MOVEI R,[ASCIZ /
Cmnd switches: /]
PUSHJ P,TYPSTR
SETZ D,
PUSHJ P,HELP0A
JRST TELLS2
TYPSTR: TLOA R,440700 ;MAKE BYTE PTR
IDPB A,Q
ILDB A,R
JUMPN A,.-2
POPJ P,
UPDATE: MOVE A,TODAY
CAMN A,DATIN ;GOT TODAY'S DATA FILE IN CORE?
SETZM DATIN ;YES, PRETEND WE DON'T
POPJ P,
UNSEEN: SETZM SEEN ;PRETEND WE HAVEN'T SEEN ANY STORIES
POPJ P,
HEADLI: SETZ B,
CAIN C,"="
PUSHJ P,INNBR
MOVEM B,HLINES
JRST SETSWT
SETFRM: CAIN C,"="
PUSHJ P,GETCH
PUSHJ P,RDNBR ;READ NUMBER OF LINES PER FRAME FOR TTY MODE
JUMPG B,.+2
MOVEI B,-1 ;NO ARG, USE INFINITY
MOVEM B,TTSIZE
POPJ P,
;FLSCAN
REPEAT 0,<
FLSCAN: MOVE B,TYPNT
SKIPA A,C
ILDB A,B
CAIE A,"←"
JUMPN A,.-2
JUMPE A,CPOPJ
PUSHJ P,GETFIL ;SCAN FILENAME
JRST FLSERR
MOVSI A,'AP '
TLON F,GOTEXT ;GOTEXT=FILB; NOTE FILENAME FOUND. ANY EXT?
MOVEM A,FILEF+1 ;NO EXTENSION GIVEN. USE STANDARD EXTENSION
PUSHJ P,SWSCAN ;SCAN SWITCHES BETWEEN FILENAME AND LEFT ARROW
CAIN C,"←"
JRST GETCH
OUTSTR SORRY
OUTSTR [ASCIZ/ILLEGAL CHARACTER AFTER FILENAME/]
JRST FLSER1
FLSERR: OUTSTR SORRY
OUTSTR [ASCIZ/ILLEGAL FILENAME SPECIFICATION/]
FLSER1: MOVE A,TYPNT
MOVEM A,TTMS+1 ;SET UP TTYMES POINTER FOR TYPING OUT BAD STUFF
JRST SERR
>;END REPEAT 0
;GETFIL NOLOOK NOENTR PRFILE
COMMENT ⊗
Call with AC C containing first char of filename, and TYPNT containing
a byte pointer into rest of name.
Call by:
PUSHJ P,GETFIL
<FILENAME-SPECIFICATION-ERROR RETURN>
<SUCCESS RETURN>
On success return, filename will be in four-word block at FILEF.
ACCUMULATOR USAGE:
C holds current character.
E counts characters in each part of name, ext, p, pn.
R is byte pointer into filename block; also temp AC.
F is flag register with following LEFT-half flags:
QUOTE ;filename quoted with ↓
GOTEXT ;have seen extension
GOTP ;have seen project
GOTPN ;have seen programmer name
STORAGE:
TYPNT is byte pointer to input string containing filename.
FILEF is a four-word LOOKUP-type block for holding scanned filename.
end of comment ⊗
GETFIL: SETZM FILEF
MOVE E,[FILEF,,FILEF+1]
BLT E,FILEF+3 ;clear 4-word filename block
TLZ F,QUOTE!GOTEXT!GOTP!GOTPN
MOVE R,[POINT 6,FILEF]
MOVEI E,6 ;limit filename to 6 chars
JRST GETFL0
GETFL1: TRZ C,40 ;convert char to sixbit
TRZE C,100
TRO C,40
SOJL E,.+2
IDPB C,R
GETFL2: ILDB C,TYPNT
GETFL0: CAIN C,"↓"
TLCA F,QUOTE
CAIN C,TAB
JRST GETFL2 ;IGNORE ALL TABS
CAIE C,"←"
CAIN C,"/"
JRST GETFL5 ;END OF FILENAME
CAIG C,"z"
CAIGE C," " ;legal SIXBIT char?
JRST GETFL5 ;NO. ASSUME END OF FILENAME
TLNE F,QUOTE ;ARE WE QUOTING A NAME?
JRST GETFL1 ;YES, DON'T MAKE SPECIAL TESTS
CAIN C,"["
JRST GETFP ;PROJECT NEXT
CAIN C,","
JRST GETFPN ;PROGRAMMER NAME NEXT
CAIN C,"]"
JRST GETFL4 ;END OF PPN
CAIN C,"."
JRST GETFLX ;EXTENSION NEXT
CAIN C," "
JRST GETFL2 ;IGNORE SPACES
CAIGE C,"0"
JRST GETFL5 ;NOT A LETTER OR DIGIT--END OF FILENAME
CAILE C,"9"
CAIL C,"a"
JRST GETFL1 ;DIGIT OR SMALL LETTER: OK
CAIL C,"A"
CAILE C,"Z"
JRST GETFL5 ;NOT A LETTER OR DIGIT--END OF FILENAME
JRST GETFL1 ;CAPITAL LETTER: OK
GETFLX: TLOE F,GOTEXT ;EXTENSION NEXT
JRST BADNAM ;OOPS, TWO EXTENSIONS
MOVE R,[POINT 6,FILEF+1]
GETFL3: MOVEI E,3
JRST GETFL2
GETFP: TLOE F,GOTP
JRST BADNAM ;OOPS, TWO PROJECTS
MOVE R,[POINT 6,FILEF+3]
JRST GETFL3
GETFPN: TLON F,GOTPN
TLNN F,GOTP
JRST BADNAM ;OOPS, TWO PROGRAMMER NAMES OR MISSING PROJECT
MOVE R,[POINT 6,FILEF+3,17]
JUMPLE E,GETFL3
EXCH C,FILEF+3
LSH C,-6 ;RIGHT-JUSTIFY PROJECT
SOJG E,.-1
EXCH C,FILEF+3
JRST GETFL3
GETFL4: ILDB C,TYPNT ;GET CHAR AFTER "]"
GETFL5: TLNN F,GOTP ;PROJECT SPECIFIED?
JRST CPOPJ1 ;NO, DONE
TLNN F,GOTPN ;PROGRAMMER NAME SPECIFIED?
JRST GETFL6 ;NO, MAKE SURE PROJECT IS RIGHT JUSTIFIED
JUMPLE E,CPOPJ1 ;YES. PROGRAMMER NAME ALREADY RIGHT JUSTIFIED?
HRRZ R,FILEF+3 ;NO
LSH R,-6 ;RIGHT JUSTIFY PROGRAMMER NAME
SOJG E,.-1
JRST GETFL8
GETFL6: JUMPLE E,GETFL7 ;PROJECT ALREADY RIGHT JUSTIFIED?
HLLZ R,FILEF+3 ;NO
LSH R,-6 ;RIGHT-JUSTIFY PROJECT
SOJG E,.-1
HLLZM R,FILEF+3
GETFL7: SETZ R, ;GET OWN DISK PPN
DSKPPN R,
GETFL8: HRRM R,FILEF+3 ;USE PROGRAMMER NAME FROM ALIAS
CPOPJ1: AOS (P) ;FILENAME SUCCESSFULLY SCANNED
BADNAM: POPJ P,
NOLOOK: PUSHJ P,PRFILE ;TYPE OUT FILENAME
OUTSTR [ASCIZ/ -- LOOKUP FAILED -- /]
HRRZ X,X ;GET ERROR CODE
CAILE X,MAXERR
MOVEI X,MAXERR
OUTSTR @FERROR(X)
OUTSTR [ASCIZ/.
/]
POPJ P,
NOENTR: PUSHJ P,PRFILE ;TYPE OUT FILENAME
NOENT1: OUTSTR [ASCIZ/ -- ENTER FAILED -- /]
HRRZ X,X ;GET ERROR CODE
CAILE X,MAXERR
MOVEI X,MAXERR
OUTSTR @FERROR(X)
OUTSTR [ASCIZ/.
/]
POPJ P,
FERROR: [ASCIZ/NO SUCH FILE/]
[ASCIZ/ILLEGAL PPN/]
[ASCIZ/PROTECTION VIOLATION/]
[ASCIZ/FILE BUSY/]
MAXERR←←.-FERROR
[ASCIZ/BAD RETRIEVAL OR OTHER HORRIBLE ERROR/]
PRFILE: MOVE Q,[POINT 7,BUF2]
MOVE B,W
PUSHJ P,SIXOUT ;TYPE FILE NAME
HLLZ B,X
JUMPE B,PRFIL1
MOVEI A,"."
IDPB A,Q
PUSHJ P,SIXOUT ;TYPE EXTENSION IF NON-ZERO
PRFIL1: JUMPE Z,PRFIL2
MOVEI A,"["
IDPB A,Q
HLLZ B,Z
PUSHJ P,SIXOUT ;TYPE PROJECT
MOVEI A,","
IDPB A,Q
HRLZ B,Z
PUSHJ P,SIXOUT ;TYPE PROGRAMMER NAME
MOVEI A,"]"
IDPB A,Q
PRFIL2: SETZ A,
IDPB A,Q
OUTSTR BUF2 ;TYPE OUT WHOLE FILENAME
POPJ P,
;MAKLST COUNT
;MAKE CURRENT STORY LIST FROM EXPR
MAKLST: SETZM ESCIFG ;NO ESC-I TYPED YET
SETZM BACK ;INITIALIZE NULL PTR TO BACK OF NEW STORY LIST
SETZM FRONT ;PTR TO FRONT OF NEW STORY LIST
TLZ F,TMP1B ;CLEAR FLAG INDICATING STORY LIST SPACE NOT EXCEEDED
MOVE D,DATIN ;SEE WHICH DAY'S DATA IS IN CORE
MOVEM D,OLDDAT ;REMEMBER DATE ALREADY PROCESSED
MOVE A,WIREIN ;WIRE SERVICE CODE OF DATA IN CORE
MOVEM A,OLDWIR ;REMEMBER WIRE SERVICE OF OLD DATA
CAML D,DATE1 ;DO WE NEED THAT DAY'S DATA?
CAMLE D,DATE2
JRST MAKL0A ;NO
TDNE F,WIRESB(A) ;WANT THAT WIRE NOW?
PUSHJ P,ONEDAY ;YES, USE IT
MAKL0A: MOVEI Z,NWIRES-1 ;CODE OF LAST OF WIRES
SKIPN ALLOK
SUBI Z,NLIMIT ;NOT ALL WIRES AVAILABLE
MOVEM Z,CWIRE
TDNN F,WIRESB(Z) ;WANT THIS NEWS
SOJGE Z,.-2 ;NO
JUMPGE Z,MAKLS0
OUTSTR [ASCIZ/NO WIRES SELECTED./]
TRZ F,SHOWB
POPJ P,
MAKLS0: TDNN F,WIRESB(Z) ;WANT THIS WIRE?
JRST MAKL2A ;NO
MOVE D,DATE1 ;GET STARTING DATE
MAKLS1: CAME D,OLDDAT ;ALREADY DONE THIS DATE?
JRST MAKL1A ;NO
MOVE Z,CWIRE
CAMN Z,OLDWIR ;DONE THIS DATE FOR THIS WIRE?
JRST MAKLS2 ;YUP
MAKL1A: SKIPE ESCIFG
JRST MAKLS9 ;ESC-I TYPED
PUSHJ P,REDDAT ;NO. READ IN DATA (REDDAT SKIPS ON FAILURE)
PUSHJ P,ONEDAY ; AND ADD TO STORY LIST USING THAT DATE
MAKLS2: CAMGE D,DATE2 ;END OF DATE RANGE YET?
AOJA D,MAKLS1 ;NO, GO ON TO NEXT DATE
MAKL2A: SOSL Z,CWIRE ;ANY MORE WIRES?
JRST MAKLS0 ;YES
SKIPE ESCIFG
TLZ F,IFILB ;ESC-I TYPED
MAKLS8: SETZM ASEEN ;NUMBER OF STORIES ALREADY SEEN
TRNN F,AGAINB ;WANT TO SEE STORIES AGAIN?
PUSHJ P,REMOVE ;NO, REMOVE STORIES ALREADY SEEN FROM LIST
SKIPE C,FRONT ;ANYTHING FOUND?
JRST MAKLS3 ;YES
OUTSTR [ASCIZ/No/] ;no
TRZ F,SHOWB ;DONT AUTOMATICALLY SHOW USER ANY STORIES THIS TIME
JRST MAKLS5
MAKLS3: HRL C,BACK ;PUT POINTER TO END OF LIST IN LH
EXCH C,CURREN ;MAKE NEW LIST THE CURRENT ONE
EXCH C,PREVIO ;MAKE OLD CURRENT ONE THE NEW PREVIOUS ONE
PUSHJ P,RELLST ;AND RELEASE THE OLD PREVIOUS LIST
MOVEI C,1
EXCH C,FCURR
MOVEM C,FPREV
TRNN F,CHRONB ;DO WE WANT NEW LIST IN CHRONOLOGICAL ORDER?
PUSHJ P,REVCUR ;NO, REVERSE NEW LIST
HRRZ C,CURREN
MOVE A,FCURR ;COUNT NUMBER OF STORIES IN NEW LIST
MAKLS4: HRRZ C,STYLST(C) ;GET PTR TO NEXT STORY IN LIST
JUMPE C,.+2 ;END OF LIST?
AOJA A,MAKLS4 ;NO, COUNT A STORY
EXCH A,NCURR ;STORE NUMBER OF STORIES IN LIST
MOVEM A,NPREV
SETZM HEADIN ;NO HEADLINE STORY IN CORE
MOVE A,NCURR
CAIN A,1 ;NO HEADLINE STORY IF ONLY ONE STORY
JRST MAKLS7
TRNE F,HEADLB ;WANT HEADLINE STORY?
PUSHJ P,INSHED ;YES INSERT ENTRY IN STORY LIST FOR HEADLINE STORY
COUNT: MOVE A,NCURR
PUSHJ P,DECOUT ;PRINT NUMBER OF STORIES FOUND
MAKLS5: OUTSTR [ASCIZ/ stories found./]
IFN FAKE,<POPJ P,>
MAKLS6: SKIPN A,ASEEN ;NUMBER OF STORIES ALREADY SEEN
JRST MAKL10
OUTSTR [ASCIZ / (Not counting /]
PUSHJ P,DECOUT
OUTSTR [ASCIZ / stories previously seen.)/]
SETZM ASEEN
MAKL10: TLZE F,TMP1B ;DID WE RUN OUT OF STORY LIST SPACE ANYWHERE?
OUTSTR [ASCIZ /
STORY LIST SPACE WAS EXCEEDED; SOME STORIES LOST FROM LIST.
/] ;YES
POPJ P,
MAKLS7: OUTSTR [ASCIZ /1 story found./]
TRC F,HEADLB!SHOWB
TRCN F,HEADLB!SHOWB ;WANT HEADLINE STORY (AND SHOWING AUTOMATICALLY)
OUTSTR [ASCIZ / (no headlines made)/]
JRST MAKLS6
MAKLS9: OUTSTR [ASCIZ /MANUAL INTERRUPTION. NOT ALL DAYS IN DATE RANGE SEARCHED.
/]
TLZ F,IFILB
JRST MAKLS8
REMOVE: SKIPN C,FRONT
POPJ P, ;NULL LIST IS EASY
REMOV1: HLRZ B,STYFOL(C) ;WIRE SERVICE CODE (AP,NYT,...)
ROT B,-3 ;MAKE CODE HIGH ORDER 3 BITS
IOR B,STYTIM(C) ;BITS 3:17 ARE DATE
HRR B,STYPTR(C) ;PTR TO TEXT OF STORY IN RIGHT HALF
MOVE A,SEEN ;NBR OF STORIES ALREADY SEEN
CAMN B,SEEN(A) ;ALREADY SEEN THIS STORY?
JRST REMOV3 ;YES, REMOVE IT FROM CURRENT STORY LIST
SOJG A,.-2 ;CHECK ALL STORIES SEEN
HRRZ C,STYLST(C) ;MOVE DOWN STORY LIST
REMOV2: JUMPN C,REMOV1
POPJ P,
REMOV3: HRRZ A,STYLST(C) ;FORWARD STORY PTR
HLRZ B,STYLST(C) ;BACKWARD STORY PTR
JUMPE B,[MOVEM A,FRONT;NEW FIRST STORY IN LIST
JRST .+2]
HRRM A,STYLST(B) ;MAKE PREV STORY PT TO NEXT ONE
JUMPE A,[MOVEM B,BACK ;NEW LAST STORY IN LIST
JRST .+2]
HRLM B,STYLST(A) ;MAKE NEXT STORY PT BACK TO PREV ONE
AOS ASEEN ;COUNT NBR OF STORIES REMOVED FROM LIST
MOVE B,STYLST ;PICK UP FREE LIST HEADER
MOVEM B,STYLST(C) ;MAKE SLOT POINT TO OLD FREE LIST
HRRZM C,STYLST ;MAKE SLOT FIRST ELEMENT IN NEW FREE LIST
MOVE C,A ;PTR TO NEXT STORY IN LIST
JRST REMOV2
;ONEDAY SETOP RETLST NOLIST ONE0 NXTWD NXTERM FOUND FIVOUT COPYL-M
TRMDSP: ONE0 ;END OF EXPRESSION
SETOP ;INTERSECTION
SETOP ;SET DIFFERENCE
SETOP ;UNION
SEQT ;SEQUENCE NUMBER RANGE
RECT ;RECENT-STORIES TERM
TR2DSP: INTERS
SETDIF
UNION
TRDSPM: INTERM ;DISPATCH TABLE WHEN 2ND TERM IS NUMBER
SETDIM
UNIONM
DELSTY: HRRZ M,STYLST(A) ;POINTER TO NEXT STORY IN STYLST
JUMPE B,DELST2 ;JUMP IF NO PREVIOUS STORY
HRRM M,STYLST(B) ;MAKE PREVIOUS STORY POINT TO NEXT ONE
DELST1: JUMPN M,.+2 ;JUMP UNLESS NO NEXT STORY
HRLM B,(P) ;CHANGE POINTER TO NEW LAST STORY IN LIST
HRRZ N,STYLST ;FREE LIST PTR
HRRZM A,STYLST ;MAKE FREE LIST HEADER POINT TO FREED SLOT
EXCH N,STYLST(A) ;MAKE FREED SLOT POINT TO OLD FREE LIST
HRRZ A,N ;PICK UP PTR TO NEXT STORY
JRST ONE0D
DELST2: HRRM M,(P) ;CHANGE POINTER TO NEW FIRST STORY IN LIST
JRST DELST1
NOLIST: SETZ N,
TLO F,TMP1B ;NOTE THAT WE RAN OUT OF STORY LIST SPACE
NOLIS1: HRRZ M,STYLST(N)
JUMPE M,CPOPJ
HRRZ N,STYLST(M)
JUMPN N,NOLIS1
MOVE N,M
POPJ P,
ONENO: PUSHJ P,NOLIST
JRST ONE3
ONE0: MOVE A,(P) ;GET POINTER TO FINAL LIST
JUMPE A,ONE10
JUMPG A,.+2
PUSHJ P,ONEREC ;ALL HE WANTS IS THE MOST RECENT STORIES
MOVE M,DATIN ;GET DATE OF NEWS WE ARE CHECKING
CAMN M,DATE1 ;IS THIS THE BEGINNING DATE IN RANGE?
SKIPG TIME1 ;YES, IS THERE A BEGINNING TIME SPECIFIED?
JRST ONE0A ;NO
MOVEI D,BNDCHK ;ADDRESS OF ROUTINE TO CHECK BEGIN AND END TIMES
CAMN M,DATE2 ;IS THIS ALSO THE ENDING DATE?
SKIPGE TIME2 ;YES, IS THERE ALSO AN ENDING TIME SPECIFIED?
MOVEI D,BEGCHK ;NO, ADDRESS OF ROUTINE TO CHECK ONLY BEGIN TIME
JRST ONE0B
ONE0A: CAMN M,DATE2 ;IS THIS THE ENDING DATE IN RANGE?
SKIPGE TIME2 ;YES, IS THERE AN ENDING TIME SPECIFIED?
JRST ONE1A ;NO, DON'T CHECK FOR TIMELINESS OF STORIES
MOVEI D,ENDCHK ;YES, ADDRESS OF ROUTINE TO CHECK ONLY END TIME
ONE0B: SETZ B,
ONE0C: HLRZ C,STYLST(A) ;POINTER TO ENTRY IN .DAT STORY LIST
PUSHJ P,(D) ;CHECK IF STORY IS IN CORRECT TIME RANGE
JRST DELSTY ;NOT IN TIME RANGE--REMOVE STORY FROM LIST
MOVE B,A
HRRZ A,STYLST(A) ;ADVANCE DOWN LIST
ONE0D: JUMPN A,ONE0C ; UNTIL END
MOVE A,(P) ;GET BACK POINTER TO FINAL LIST
ONE1A: SETZB B,N ;B WILL PT TO PREVIOUS SLOT IN STORY LIST (BACK PTR)
ONE1: HLRZ C,STYLST(A) ;PICK UP POINTER TO STORY ENTRY
MOVE E,DATA+1(C) ;GET ADDRESS OF STORY
MOVEM E,STYPTR(A) ; AND PLACE IN STORY LIST ENTRY
HRLZ E,DATIN ;GET DATE OF STORY
HLR E,DATA+2(C) ; AND TIME OF STORY
MOVEM E,STYTIM(A) ; AND PLACE IN STORY LIST ENTRY
HRLZ E,WIREIN ;PICK UP CODE OF WIRE SERVICE
MOVEM E,STYFOL(A) ; AND PLACE IN STORY LIST ENTRY
MOVE M,A ;M WILL PT TO STORY LIST SLOT OF PREV PART OF STORY
ONE2: HRRZ C,DATA+3(C) ;PICK UP POINTER TO FOLLOW-UP STORY, IF ANY
JUMPE C,ONE3 ;NO FOLLOW-UP
HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,ONENO ; (IF ANY)
HRLM M,STYLST(N) ;FILL IN BACK PTR TO PREV PART
MOVE E,DATA+1(C) ;GET ADDRESS IN TXT OF FOLLOW-UP STORY
MOVEM E,STYPTR(N) ; AND PLACE IN SUBLIST ENTRY
MOVN E,A ;MAKE NEGATIVE PTR TO ORIGINAL
HRL E,WIREIN ; PUT CODE OF WIRE SERVICE IN LEFT HALF
MOVEM E,STYFOL(N) ; AND PUT INTO SUBLIST ELEMENT
HRLZ E,DATIN ;GET DATE OF STORY
HLR E,DATA+2(C) ; AND TIME OF STORY
MOVEM E,STYTIM(N) ; AND PLACE INTO SUBLIST ELEMENT
MOVE M,N ;SAVE PTR TO LAST SLOT IN SUBLIST
JRST ONE2
ONE3: JUMPE N,ONE4 ;IF NO FOLLOW-UPS AT ALL, NOTHING TO DO HERE
HRRZ C,STYLST(N) ;PICK UP FREE PTR
EXCH C,STYLST ; AND STUFF IN FREE HEADER, SAVING OLD FREE HEADER
HRRM C,STYFOL(A) ;MAKE ORIGINAL STORY PT TO FIRST FOLLOW-UP
HLLZS STYLST(N) ;PUT NULL LINK AT END OF SUBLIST
SETZ N,
ONE4: HRLM B,STYLST(A)
MOVE B,A
HRRZ A,STYLST(A) ;GET LINK TO NEXT SLOT IN MAIN LIST
JUMPN A,ONE1
;NOW WE WILL LINK THE NEWLY CONSTRUCTED DOUBLY-LINKED LIST TO THE OLD LIST
ONE10: POP P,A ;RETRIEVE POINTERS TO FRONT AND BACK OF NEW LIST
MOVE D,DATIN ;DATE OF STORIES IN NEW LIST
JUMPE A,CPOPJ ;IF NO NEW LIST, FORGET IT
SKIPN B,BACK ;GET POINTER TO BACK OF OLD LIST
JRST ONE19 ;NULL OLD LIST
MOVE E,STYTIM(B) ;GET DATE/TIME OF LAST ELEMENT IN PREVIOUS LIST
MOVE C,STYTIM(A) ;GET DATE/TIME OF FIRST ELEMENT IN NEW LIST
CAMGE C,E ;IF THAT IS BEFORE NEW STUFF, ADD AT END OF OLD LIST
JRST ONE11 ;ADD AT FRONT OR IN MIDDLE OF LIST
;LINK NEW LIST TO END OF OLD ONE
HRLM B,STYLST(A) ;MAKE NEW LIST POINT BACK TO OLD ONE
HRRM A,STYLST(B) ;MAKE OLD LIST POINT FORWARD TO NEW ONE
HLRZM A,BACK ;SAVE POINTER TO END OF NEW COMBINED LIST
POPJ P,
ONE19: HRRZM A,FRONT ;POINTER TO FRONT OF NEW LIST
HLRZM A,BACK ;POINTER TO END OF NEW LIST
POPJ P,
ONE11: MOVE L,FRONT ;POINTER TO FRONT OF OLD LIST
ONE12: MOVE E,STYTIM(L) ;DATE/TIME OF ELEMENT IN OLD LIST
CAML C,E ;IS THIS PROPER PLACE TO INSERT IN LIST?
JRST ONE14A ;NO
SKIPA B,STYLST(A) ;ADVANCE DOWN NEW LIST UNTIL FOUND LAST STORY THAT GOES HERE
ONE13: HRRZ B,STYLST(B) ;NEXT STORY IN NEW LIST
TRNN B,-1 ;ANY NEXT STORY AT ALL?
JRST [HLRZ M,A ;NO, PTR TO LAST NEW STORY
JRST ONE13A]
MOVE C,STYTIM(B) ;DATE/TIME OF NEW STORY
CAMG C,E ;THIS STORY FIT HERE?
JRST ONE13 ;YES
HLRZ M,STYLST(B) ;POINTER TO LAST NEW STORY THAT GOES HERE IN OLD LIST
ONE13A: HRRM L,STYLST(M) ;MAKE LAST NEW STORY POINT TO NEXT OLD ONE
HLRZ N,STYLST(L) ;PTR TO PREV OLD STORY
HRLM M,STYLST(L) ;MAKE NEXT OLD ONE POINT BACK TO LAST NEW ONE
JUMPE N,[HRRZM A,FRONT
JRST .+2]
HRRM A,STYLST(N) ;MAKE PREV OLD STORY POINT TO FIRST NEW ONE
HRLM N,STYLST(A) ;MAKE FIRST NEW STORY POINT BACK TO PREV OLD ONE
TRNN B,-1 ;ANY MORE STORIES IN NEW LIST
POPJ P, ;NO
HRR A,B ;YES, POINTER TO FIRST REMAINING NEW STORY
ONE14A: HRRZ L,STYLST(L) ;NEXT ELEMENT IN OLD LIST
JUMPN L,ONE12
ONE14: MOVE N,BACK ;PTR TO LAST ELEMENT IN OLD LIST
HRRM A,STYLST(N) ;MAKE LAST ELEMENT IN OLD LIST POINT TO FIRST ELEMENT IN NEW LIST
HRLM N,STYLST(A) ;MAKE FIRST ELEMENT IN NEW LIST POINT BACK TO END OF OLD LIST
HLRZM A,BACK ;END OF NEW LIST IS NOW END OF RESULTANT LIST
POPJ P,
ONEDAY: MOVEI C,POLISH ;SET UP ABSOLUTE ADDRESS OF POLISH EXPR
NXTERM: MOVE B,(C) ;GET NEXT TERM IN EXPR
JUMPL B,NXTWD0 ;B<0 => TEXT OF KEYWORD
CAIG B,XMAX ;B≤XMAX => B IS SPECIAL TERM CODE OR OPERATOR
JRST @TRMDSP(B) ;DISPATCH TO HANDLE WHATEVER CASE WE HAVE
NXTWD0: MOVEI D,1 ;SET UP RELATIVE PTR TO DICT HEADER
NXTWD: HRRZ D,DATA(D) ;GET RELATIVE PTR TO NEXT DICT WORD
MOVEI A,DATA+1(D) ;ABSOLUTE PTR TO TEXT OF DICT WORD
SKIPGE DATA(D) ;DO WE HAVE A STRUCTURALLY INVOLVED KEYWORD?
ADDI A,2 ;YES
CAMLE B,(A) ;B IS FIRST WORD OF KEYWORD, A POINTS INTO DICT
JRST NXTWD ;LOOK AT NEXT DICT WORD
CAME B,(A) ;EXACT MATCH?
JRST PUSH0 ;NO, KEYWORD NOT FOUND IN DICT
TRNE B,1 ;END OF KEYWORD? (IE, HAS WHOLE WORD MATCHED?)
AOJA C,FOUND ;YES
MOVEI L,1(C) ;NO, GET ABSOLUTE ADDRESS OF NEXT PART OF KEYWORD
NXTWD1: ADDI A,1 ;ADVANCE TO NEXT PART OF DICT WORD
MOVE E,(L) ;PICK UP NEXT PART OF KEYWORD
CAMLE E,(A) ;COMPARE KEYWORD AND DICTWORD
JRST NXTWD ;GO ON TO NEXT DICTWORD
CAME E,(A) ;EXACT MATCH?
JRST PUSH0 ;NO. KEYWORD NOT FOUND IN DICT
TRNN E,1 ;END OF KEYWORD?
AOJA L,NXTWD1 ;NO, LOOK AT NEXT PART
MOVEI C,1(L) ;ADJUST EXPR POINTER PAST KEYWORD
FOUND: HLRE L,1(A) ;PICK UP PTR TO FIRST STORY FOR DICTWORD
JUMPLE L,PUSH0A ;L≤0 MEANS NO OCCURRENCES FOR THIS WORD
PUSHJ P,COPY ;COPY LIST OF STORIES INTO A STORY LIST
PUSH P,W ; AND SAVE PTR TO LIST
JRST NXTERM ;CONTINUE TO PROCESS POLISH EXPR
PUSH0A:
REPEAT 0,<
JUMPE L,PUSH0 ;LESS THAN 0 MEANS IS REALLY A NON-KEYWORD DICTWORD
OUTSTR [ASCIZ /COMMON WORD ASSUMED PRESENT IN ALL STORIES: /]
PUSHJ P,FIVOUT
OUTSTR CRLF
MOVEI B,-1 ;SEQ NBR RANGE OF 0:777777
SUBI C,2
JRST SEQT0 ;GET COMPLETE STORY LIST
>;END REPEAT 0
PUSH0: MOVEI D,1 ;ADVANCE TO END OF KEYWORD
TDNN D,(C) ;LOOK FOR LOW ORDER BIT ON AT END
AOJA C,.-1
PUSH P,[0] ;NULL STORY LIST FOUND
AOJA C,NXTERM
FIVOUT: TRZ B,1 ;MAKE SURE LOW ORDER BIT IS OFF
FIVOU1: SETZ A,
LSHC A,5
ADDI A,100 ;CONVERT FROM 5-BIT TO ASCII
OUTCHR A
JUMPN B,FIVOU1
POPJ P,
RETLST: HLRZ B,A ;PICK UP POINTER TO END OF LIST BEING RETURNED
EXCH A,STYLST ;STORE NEW FREE HEADER, PICK UP OLD ONE
HRRZM A,STYLST(B) ;MAKE RETURNED LIST POINT TO OLD FREE LIST
POPJ P,
SETOP: MOVE L,-1(P) ;SET UP FIRST ARGUMENT FOR A SET OPERATION
MOVE M,(P) ;SECOND ARG
JUMPGE L,.+2 ;JUMP IF FIRST ARG IS NOT RECENT-STORIES NUMBER
PUSHJ P,RECL ;MAKE L BE LIST OF N MOST RECENT STORIES
JUMPL M,@TRDSPM-1(B) ;JUMP IF SECOND ARG IS RECENT-STORIES NUMBER
SETZ N, ;INITIALIZE RESULTANT LIST TO NULL
PUSHJ P,@TR2DSP-1(B) ;DISPATCH TO OPERATION, WHICH MAY TAKE SKIP RETURN
PUSHJ P,FINOP ;BREAK OFF NEW LIST FROM FRONT OF FREE LIST
SKIPE A,(P)
PUSHJ P,RETLST ;RETURN ONE OLD LIST TO FREE LIST
SKIPE A,-1(P)
SETOP1: PUSHJ P,RETLST ;FREE OTHER LIST
MOVEM W,-1(P) ;PUT RESULTANT LIST ON STACK (REPLACING 1ST ARG)
UNIONM: SUB P,[1,,1] ;REMOVE SECOND ARG FROM STACK
AOJA C,NXTERM ;CONTINUE ON POLISH EXPR
COPYNO: PUSHJ P,NOLIST
JRST FINOP
COPY: SETZ N,
SKIPA L,1(A)
COPY1: MOVE L,DATA(L) ;PICK UP NEXT LIST ELEMENT
HRRZ N,STYLST(N) ;GET NEW SLOT FOR NEXT ELEMENT
JUMPE N,COPYNO ; (IF ANY)
HLLM L,STYLST(N) ;PUT PTR TO STORY IN NEW SLOT
TRNE L,-1 ;END OF LIST?
JRST COPY1 ;NO
FINOP: JUMPE N,FINOP1 ;IF NEW LIST IS NULL, NOT MUCH TO DO
HRRZ W,STYLST(N) ;PICK UP FREE PTR
HLLZS STYLST(N) ;PUT NULL LINK ON END OF NEW LIST
EXCH W,STYLST ;STORE NEW FREE HEADER AND PICK UP HEADER OF NEW LIST
HRL W,N ;PUT POINTER TO END OF LIST IN LEFT HALF
POPJ P,
FINOP1: SETZ W, ;INDICATE NULL LIST
POPJ P,
COPYL: MOVEI X,-2(P) ;POINTER TO LIST HEADER FOR LIST WE ARE COPYING
SKIPA M,L
COPYM: MOVEI X,-1(P)
JUMPE M,CPOPJ
HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,NOLIST ; (IF ANY)
HLL M,(X) ;PTR TO END OF OLD LIST
HRLM M,(X) ;CHANGE POINTER TO END OF OLD LIST
MOVE W,STYLST(M) ;PICK UP STORY PTR AND LINK
TRNN W,-1 ;ANY MORE ELEMENTS IN OLD LIST?
MOVSI M,(N) ;NO, SET PTR TO LAST ELEMENT IN NEW LIST
EXCH W,STYLST(N) ;AND PUT INTO NEW LIST. SAVE OLD FREE PTR,
EXCH W,STYLST ;STORE NEW FREE HEADER AND PICK UP HDR OF NEW LIST
HLL W,M ;PTR TO END OF NEW LIST
JRST CPOPJ1 ;MAKE SURE WE DON'T CALL FINOP
INTERS: JUMPE L,CPOPJ ;NULL INPUT LIST => NULL OUTPUT LIST
INTER0: JUMPE M,CPOPJ ; DITTO
HLRZ W,STYLST(L) ;GET STORY PTR FROM FIRST LIST
INTER3: HLRZ X,STYLST(M) ; AND ONE FROM SECOND LIST
CAME W,X ;STORY IN BOTH LISTS?
JRST INTER1 ;NO
HRRZ N,STYLST(N) ;YES--GET NEXT FREE SLOT
JUMPE N,NOLIST ; (IF ANY)
HRLM W,STYLST(N) ;STORE STORY PTR IN NEW SLOT
HRRZ M,STYLST(M) ;ADVANCE DOWN EACH OLD LIST
INTER2: HRRZ L,STYLST(L)
JUMPN L,INTER0
POPJ P,
INTER1: CAMG W,X ;ADVANCE IN LIST THAT IS "BEHIND"
JRST INTER2 ; FIRST LIST
HRRZ M,STYLST(M) ; SECOND LIST
JUMPN M,INTER3
POPJ P,
SETDIF: JUMPE M,COPYL ;NULL SECOND ARG => FIRST ARG IS RESULT
SETDI0: JUMPE L,CPOPJ ;NULL INPUT LIST => NULL OUTPUT LIST
HLRZ X,STYLST(M) ;GET STORY PTR FROM SECOND LIST
SETDI3: HLRZ W,STYLST(L) ;GET STORY PTR FROM FIRST LIST
CAME W,X ;STORY IN BOTH LISTS?
JRST SETDI1 ;NO
HRRZ L,STYLST(L) ;YES--ADVANCE DOWN EACH OLD LIST
SETDI2: HRRZ M,STYLST(M)
JUMPN M,SETDI0
JRST COPYL ;SECOND LIST EXPIRED
SETDI1: CAML W,X
JRST SETDI2 ;ADVANCE DOWN SECOND LIST
HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,NOLIST ; (IF ANY)
HRLM W,STYLST(N) ;PUT STORY PTR INTO NEW SLOT
HRRZ L,STYLST(L) ;ADVANCE IN FIRST LIST
JUMPN L,SETDI3
POPJ P,
UNION: JUMPE L,COPYM ;NULL FIRST LIST => COPY SECOND LIST
UNION0: JUMPE M,COPYL ;NULL SECOND LIST => COPY FIRST LIST
UNION3: HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,NOLIST ; (IF ANY)
HLRZ W,STYLST(L) ;GET STORY PTR FROM FIRST LIST
HLRZ X,STYLST(M) ; AND ONE FROM SECOND LIST
CAME W,X ;STORY IN BOTH LISTS?
JRST UNION1 ;NO
HRRZ M,STYLST(M) ;ADVANCE DOWN EACH OLD LIST
UNION2: HRRZ L,STYLST(L)
HRLM W,STYLST(N) ;STORE STORY PTR IN NEW SLOT
JUMPN L,UNION0
JRST COPYM
UNION1: CAMG W,X ;STORE PTR AND ADVANCE IN LIST THAT IS "BEHIND"
JRST UNION2 ; FIRST LIST
HRRZ M,STYLST(M) ; SECOND LIST
HRLM X,STYLST(N) ;STORE STORY PTR IN NEW SLOT
JUMPN M,UNION3
JRST COPYL
SEQT: MOVE B,1(C) ;PICK UP SEQ NBR RANGE
SEQT0: HLRZ A,B ;BEGINNING OF RANGE IN A, END OF RANGE IS (B)
SETZB N,D ;INITIALIZE NEW LIST (N) TO NULL
CAILE A,(B) ;SEQ NBR TERM WRAP AROUND?
JRST SEQT2 ;YES
JRST SEQT1
SEQT1A: PUSHJ P,INCLUD ;PUT STORY ON NEW LIST
SEQT1: PUSHJ P,SEQTA ;GET NEXT STORY
SEQT1B: CAIGE E,(A) ;IS IT IN RIGHT RANGE?
JRST SEQT1C
CAIG E,(B)
JRST SEQT1A ;YES
SEQT1C: HRRZ L,DATA+3(L) ;NO, SEE IF FOLLOW-UP IS IN RIGHT RANGE
JUMPE L,SEQT1
HRRZ E,DATA+2(L) ;GET SEQ NBR OF FOLLOW-UP
JRST SEQT1B
SEQT2A: PUSHJ P,INCLUD ;PUT STORY ON NEW LIST
SEQT2: PUSHJ P,SEQTA ;GET NEXT STORY
SEQT2B: CAILE E,(B) ;IN RIGHT RANGE?
CAIL E,(A)
JRST SEQT2A ;YES
HRRZ L,DATA+3(L) ;NO, SEE IF FOLLOW-UP IS IN RIGHT RANGE
JUMPE L,SEQT2
HRRZ E,DATA+2(L) ;GET SEQ NBR OF FOLLOW-UP
JRST SEQT2B
SEQT3A: ADDI C,1 ;ADJUST POINTER TO POLISH EXPR
SEQT3: JUMPE N,SEQT4 ;IF NULL LIST, JUST PUT IT ON STACK
HRRZ A,STYLST(N) ;PICK UP FREE PTR
EXCH A,STYLST ; AND PLACE IN FREE HEADER, SAVING OLD FREE HEADER
HLLZS STYLST(N) ;PUT NULL LINK ON END OF NEW LIST
HRL A,N ;PUT PTR TO END OF LIST IN LH
MOVEM A,(P) ;REPLACE RETURN ADDRESS WITH TERM ON STACK
AOJA C,NXTERM
SEQT4: SETZM (P) ;REPLACE RETURN ADDRESS WITH NULL TERM ON STACK
AOJA C,NXTERM
SEQTA: HRRZ D,DATA(D) ;ADVANCE TO NEXT STORY
JUMPE D,SEQT3A ;DONE IF NO MORE STORIES
HLRZ X,DATA+3(D) ;IS THIS A FOLLOW-UP STORY?
CAIE X,(D)
JRST SEQTA ;YES, IGNORE IT
HRRZ E,DATA+2(D) ;GET STORY'S SEQ NBR
MOVE L,D ;L WILL MOVE DOWN FOLLOW-UP STORY LIST
POPJ P,
INCLUD: HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,SEQTNO ; (IF ANY)
HRLM D,STYLST(N)
POPJ P,
SEQTNO: PUSHJ P,NOLIST
AOJA C,SEQT3
RECT: MOVN A,1(C) ;PICK UP NEGATIVE NUMBER OF STORIES
PUSH P,A ;AND PUT ON STACK AS A TERM
ADDI C,2 ;ADJUST PTR INTO EXPR
JRST NXTERM
ONEREC: MOVE L,A ;NUMBER OF RECENT STORIES WE WANT
PUSHJ P,RECL ;MAKE LIST OF THOSE STORIES
MOVE A,L ;AND LEAVE PTR TO LIST IN A
POPJ P,
RECL: SETZB N,W ;W MOVES BACK THROUGH STORY LIST
RECL1: HLRZ W,DATA(W) ;BACK UP A STORY
JUMPE W,RECL2 ;JUMP IF BACK TO BEGINNING OF STORY LIST
HLRE X,DATA+3(W) ;GET PTR TO ORIGINAL
JUMPLE X,RECL1 ;JUMP IF THIS ORIGINAL ALREADY MARKED
SKIPG DATA+3(X) ;SKIP IF ORIGINAL NOT MARKED
JRST RECL1
MOVNS DATA+3(X) ;MARK ORIGINAL AS PART OF LIST
AOJL L,RECL1 ;MARKED ENOUGH STORIES YET?
RECL2: TDZA W,W ;YES, WALK DOWN STORY LIST PICKING UP MARKED STORIES
RECL3: SKIPL X,DATA+3(W) ;IS THIS STORY MARKED?
JRST RECL4 ;NO, IGNORE IT
MOVNM X,DATA+3(W) ;YES, UNMARK IT NOW
HRRZ N,STYLST(N) ;GET NEXT FREE SLOT
JUMPE N,RECLNO ; (IF ANY)
HRLM W,STYLST(N) ;AND PUT STORY PTR INTO LIST
RECL4: HRRZ W,DATA(W) ;ADVANCE A STORY
JUMPN W,RECL3 ;STOP IF AT END OF LIST
RECL5: PUSHJ P,FINOP ;BREAK OFF LIST FROM FREE LIST
MOVE L,W ; AND RETURN PTR IN L
MOVEM L,-2(P) ; AND ALSO ON STACK
POPJ P,
MOVMS DATA+3(W) ;MAKE SURE THIS STORY ENTRY UNMARKED
RECLNO: HRRZ W,DATA(W) ;ADVANCE DOWN STORY LIST
JUMPN W,.-2
PUSHJ P,NOLIST ;NOTE THAT WE RAN OUT OF LIST SPACE
JRST RECL5
;W WILL BE THE RESULTANT LIST
;A WILL BE THE OMITTED PART OF THE ORIGINAL LIST (BACK,,FRONT)
INTERM: JUMPE L,UNIONM ;IF NULL FIRST ARG, NULL RESULT
PUSHJ P,CNTL ;COUNT NUMBER OF STORIES IN FIRST PART OF LIST L
JUMPL M,UNIONM ;JUMP IF NO OMISSIONS
SKIPA W,L ;COPY PTR TO WHOLE LIST
HRRZ W,STYLST(W) ;SKIP A STORY
SOJGE M,.-1 ;SKIPPED ENOUGH?
HRRZ A,L ;MAKE PTR TO FRONT OF OMITTED LIST
HRL A,W ;PTR TO END OF OMITTED PART OF LIST
HRRZ W,STYLST(W) ;PTR TO FIRST STORY NOT OMITTED
HLL W,L ;PTR TO END OF RESULTANT LIST
JRST SETOP1
;COUNT (NUMBER OF STORIES IN FIRST NEW PART OF LIST L)-1
CNTL: MOVE W,L
HRRZ W,STYLST(W) ;PTR TO NEXT STORY
JUMPE W,CPOPJ ;END OF LIST?
AOJA M,.-2 ;NO, COUNT A STORY AND GO ON
SETDIM: JUMPE L,UNIONM ;IF NULL FIRST ARG, NULL RESULT
PUSHJ P,CNTL ;COUNT NUMBER OF STORIES IN FIRST PART OF LIST L
JUMPL M,SETDM1 ;JUMP IF ALL STORIES WILL BE OMITTED
SKIPA W,L ;COPY PTR TO WHOLE LIST
HRRZ L,STYLST(L) ;MOVE DOWN A STORY
SOJGE M,.-1
HLLZ A,W ;PTR TO END OF OMITTED PART OF LIST
HRL W,L ;PTR TO END OF RESULTANT LIST
HRR A,STYLST(L) ;PTR TO BEGINNING OF OMITTED PART
HLLZS STYLST(L) ;PUT NULL LINK AT END OF RESULTANT LIST
JRST SETOP1
SETDM1: MOVE A,L ;FREE ENTIRE LIST
SETZ W, ;NULL RESULTANT LIST
JRST SETOP1
;ROUTINE TO CHECK THAT GIVEN STORY COMES AFTER GIVEN BEGINNING TIME OF DAY
BEGCHK: SKIPA M,C
MOVE M,N
HRRZ N,DATA+3(M) ;FIND LAST FOLLOW-UP STORY
JUMPN N,.-2
HLRZ M,DATA+2(M) ;TIME OF STORY
CAML M,TIME1 ;AFTER BEGINNING TIME?
AOS (P) ;YES
POPJ P,
;ROUTINE TO CHECK THAT GIVEN STORY COMES BETWEEN GIVEN BEGINNING AND ENDING TIMES
BNDCHK: PUSHJ P,BEGCHK ;CHECK BEGINNING TIME
POPJ P, ;FAILED
;ROUTINE TO CHECK THAT GIVEN STORY COMES BEFORE GIVEN ENDING TIME OF DAY
ENDCHK: HLRZ M,DATA+2(C) ;TIME OF STORY
CAMG M,TIME2 ;BEFORE ENDING TIME?
AOS (P) ;YES
POPJ P,
;REDDAT GETDAT CHKSEE
GETDAT: INSKIP 1 ;SKIP IF WHOLE LINE HAS BEEN TYPED
SKIPA D,DATIN ;GET DATE OF .DAT FILE IN CORE
POPJ P, ;TYPE-AHEAD PRESENT--DON'T READ .DAT NOW
CAML D,DATE1 ;IS THERE A USEFUL .DAT FILE IN CORE?
CAMLE D,DATE2
SKIPA D,DATE1 ;FALL INTO REDDAT--READ .DAT FILE FOR FIRST DATE
POPJ P,
HRRZS (P) ;CLEAR FLAG TO INDICATE CALLED REDDAT FROM GETDAT
SETZM CWIRE ;READ IN DEFAULT WIRE SERVICE DATA
;ROUTINE TO READ IN .DAT FILE FOR DATE SPECIFIED IN DAYCNT FORMAT IN AC D
;CALL: MOVE D,[<DATE>]
; PUSHJ P,REDDAT
; <SUCCESS RETURN>
; <FAILURE RETURN>
REDDAT:
IFN DEBUG, <
HRLZ W,JOBSYM↑ ;GET PTR TO SYMBOL TABLE
CAMN W,[SYM,,0] ;HAVE WE MOVED SYMBOLS YET?
JRST NOMOVE ;YES
HRRI W,SYM ;ADDRESS OF NEW LOC FOR SYMBOL TABLE
HRRM W,JOBSYM ;MAKE NEW PTR TO SYMBOL TABLE
HLRE X,JOBSYM ;GET LENGTH OF SYMBOL TABLE
MOVN X,X ; AND MAKE IT POSITIVE
CAILE X,LSYM
HALT . ;SYMBOL TABLE TOO BIG TO FIT IN ARRAY
ADDI X,-1(W) ;CALCULATE ADDRESS OF LAST WORD
BLT W,(X) ;MOVE SYMBOL TABLE
NOMOVE:
>;END DEBUG
MOVE Z,CWIRE
CAMN Z,WIREIN ;GOT DATA FOR RIGHT WIRE SERVICE?
CAME D,DATIN ;YES, ALREADY GOT CORRECT .DAT FILE IN CORE?
SKIPA W,D ;NO
POPJ P, ;YES
SETZM HEADIN ;NO HEADLINE STORY IN CORE NOW
MOVSI X,'DAT'
SETZB Y,DATIN ;FLAG (Y) INDICATING FIRST TRY TO LOOKUP .DAT FILE
MOVEM Z,WIREIN ;REMEMBER WHICH WIRE SERVICE IS GOING TO BE IN CORE
MOVE Z,WIRES(Z) ;PICK UP PPN OF WIRE SERVICE
OPEN DAT,DSK17
UFATAL 504 ;;;CANT OPEN DSK
REDDA3: LOOKUP DAT,W
JRST REDDA2
JUMPN Z,.+2
UFATAL 510 ;;;ZERO WORD COUNT IN .DAT FILE
HLLM Z,DATCMD
HLRE Z,Z
MOVN Z,Z ;LENGTH OF .DAT FILE
ADDI Z,DATA-1 ;FORM ADDRESS OF LAST WORD OF .DAT FILE
CORE Z, ;GET ENOUGH CORE FOR FILE AND NO MORE
UFATAL 514 ;;;CORE UUO FAILED
IN DAT,DATCMD
JRST REDDA1
UFATAL 520 ;;;DISK INPUT ERROR WITH .DAT FILE
DATERR: HLLZ A,(P) ;GET FLAG TO SEE IF CALLED FROM GETDAT
JUMPE A,DATER2 ;JUMP IF FROM GETDAT
OUTSTR SORRY
OUTSTR [ASCIZ/FAILED TO FIND ANY */]
MOVE A,WIREIN ;WIRE SERVICE CODE WE JUST TRIED
HLLZ B,WIRES(A) ;PPN OF WIRE SERVICE
PUSHJ P,SIXTYP ;TYPE OUT NAME OF WIRE SERVICE
OUTSTR [ASCIZ/* NEWS FOR ONE DATE /]
MOVE A,SDATE1 ;DO WE HAVE NAME OF DATE AROUND ANYWHERE?
CAMN D,DATE1
JRST DATER3
MOVE A,SDATE2
CAMN D,DATE2
JRST DATER3
MOVE A,STODAY
CAME D,TODAY
JRST DATER4 ;NO TELLING WHAT DAY WE COULDN'T FIND
DATER3: PUSH P,D
MOVE B,A ;SYSTEM FORMAT OF DATE WE COULDN'T FIND
PUSHJ P,PDATE
POP P,D
DATER4: OUTSTR CRLF
DATER2: RELEAS DAT,
JRST CPOPJ1 ;SKIP ON FAILURE
REDDA1: MOVE A,DATA+3 ;PICK UP VERSION NUMBER FROM FILE
CAME A,[' NS',,2] ;RIGHT VERSION?
JRST DATERR ;NO
RELEAS DAT,
MOVEM D,DATIN
CAME D,TODAY ;READING TODAY'S DATA AGAIN?
POPJ P, ;NO
;YEAH, MARK AS UNSEEN ANY OLD STORIES WITH NEW PARTS
MOVE Z,WIREIN
SKIPG DATEND(Z) ;ALREADY HAVE TODAY'S DATA AROUND?
JRST CHKSE2 ;NO
HLRZ A,DATA ;PTR TO LATEST STORY
JRST CHKSE1
CHKSEE: HLRZ C,DATA+3(A) ;PTR TO ORIGINAL STORY
HRRZ B,DATA+1(C) ;PTR TO TEXT OF STORY
HRL B,D ;DATE OF STORY
DPB Z,[POINT 3,B,2] ;WIRE SERVICE CODE
MOVE W,SEEN ;NBR OF STORIES ALREADY SEEN
CAMN B,SEEN(W) ;ALREADY SEEN THIS STORY?
JRST REPLAC ;YES, REMOVE IT FROM ALREADY-SEEN LIST
SOJG W,.-2 ;CHECK ALL STORIES SEEN
CHKSE0: HLRZ A,DATA(A) ;GET NEXT PREVIOUS STORY
CHKSE1: CAMLE A,DATEND(Z) ;BACK TO OLD STORIES FROM PREVIOUS .DAT FILE?
JRST CHKSEE ;NO
CHKSE2: HLRZ A,DATA ;PTR TO LATEST STORY
MOVEM A,DATEND(Z) ;REMEMBER WHERE LATEST STORY IS
POPJ P,
REPLAC: SOS B,SEEN ;MARK ONE LESS STORY SEEN
MOVE C,SEEN+1(B) ;PICK UP LAST STORY IN SEEN LIST
MOVEM C,SEEN(W) ;AND PUT IT INTO HOLE IN MIDDLE
JRST CHKSE0
REDDA2: JUMPN Y,DATERR ;FAILED ON SECOND TRY?
CAMG D,TODAY ;IN FUTURE OR
CAIGE D,7311 ; BEFORE THE BEGINNING OF TIME (13-MAY-74)?
JRST DATER2 ;YES
MOVEI Y,1
SLEEP Y,
JRST REDDA3 ;TRY AGAIN AFTER BRIEF PAUSE
;RELLST
;ROUTINE TO RETURN ELEMENTS OF A STORY LIST TO FREE STORY LIST STORAGE
;CALL WITH POINTER TO FRONT OF LIST IN RH OF C, POINTER TO BACK IN LH OF C
RELLST: SKIPN B,C ;COPY POINTER TO LIST
POPJ P, ;NULL LIST, GO HOME
RELLS1: HRRE A,STYFOL(B) ;ANY FOLLOW-UPS FOR THIS STORY?
JUMPLE A,.+2
PUSHJ P,RELLS3 ;YES. RETURN FOLLOW-UP LIST FIRST
HRRZ B,STYLST(B) ;NEXT STORY IN MAIN LIST
JUMPN B,RELLS1 ;END OF LIST?
HLRZ A,C ;YES. GET POINTER TO END OF LIST
HRRZ B,STYLST ;GET POINTER TO FRONT OF FREE LIST
MOVEM B,STYLST(A) ;MAKE FREED LIST POINT TO FRONT OF OLD FREE LIST
HRRZM C,STYLST ;FRONT OF FREED LIST IS NOW FRONT OF FREE LIST (SIC)
POPJ P,
RELLS2: MOVS A,A
RELLS3: HRL A,STYLST(A) ;GET POINTER TO NEXT FOLLOW-UP
TLNE A,-1 ;ANY FOLLOW-UP THERE?
JRST RELLS2 ;YES, CONTINUE LOOKING FOR END OF LIST
HRL A,STYLST ;GET POINTER TO FRONT OF FREE LIST
HLRZM A,STYLST(A) ;MAKE FREED LIST POINT TO FRONT OF OLD FREE LIST
HRRZ A,STYFOL(B) ;GET BACK THE PTR TO FRONT OF FREED LIST
MOVEM A,STYLST ;AND STORE IT AS PTR TO FRONT OF NEW FREE LIST
POPJ P,
;REDHED
;READ IN BEGINNING OF EACH STORY IN MAIN STORY LIST AND COMBINE IN
;CORE TO FORM SPECIAL HEADLINE STORY STORED ABOVE DAT FILE IN CORE
REDHED: SKIPE R,HEADIN ;ALREADY CREATED HEADLINE STORY?
JRST REDHE9 ;YES, SET UP POINTER TO IT
SETZM ESCIFG
OUTSTR [ASCIZ /...making headlines.../]
IFN 1 < SKIPG A,HLINES ;GIVE HIM WHAT HE ASKED FOR (UP TO 8)
>;DEFAULT NBR OF LINES/STORY IS NOW ALWAYS 2
MOVEI A,3 ;2 LINES PER STORY DEFAULT
CAILE A,=8 ;MAX NUMBER OF LINES/STORY WE WILL EVER ALLOW
MOVEI A,=8
MOVEM A,ALINES ;ACTUAL NUMBER OF LINES/STORY WE WILL HAVE
MOVE A,NCURR ;NUMBER OF STORIES IN CURRENT LIST
MOVEI B,2 ;MIN NBR OF LEADING SPACES ON 2ND & SUBSEQUENT LINES
CAIL A,=10
ADDI B,1 ;10 OR MORE STORIES, INDENT 2ND,... LINES MORE
CAIL A,=100
ADDI B,1 ;100 OR MORE STORIES, INDENT EVEN MORE
MOVEM B,NSPC2# ;NUMBER OF LEADING SPACES ON 2ND & SUBSEQUENT LINES
MOVEI A,=69 ;LINE LENGTH FOR TTYS
SKIPL LINTYP ;ON TTY?
MOVEI A,=84 ;NO, LONGER LINES WHEN ON DPYS
SUBI A,(B) ; LESS LENGTH OF INDENTATION
MOVEM A,LINLEN ;LENGTH OF EACH LINE IN HEADLINE STORY
SUBI B,1
MOVEM B,NSPC1# ;INITIAL NBR OF PADDING SPACES IN 1ST LINE/STORY
COMMENT ⊗
AT THIS POINT, AC E SHOULD POINT TO HEADLINE STORY, WHICH SHOULD BE FIRST
STORY IN MAIN LIST. WE WILL READ IN A LITTLE OF EACH SUCCESSIVE STORY (MAIN PART)
AND BUILD A HEADLINE STORY.
TO READ IN EACH STORY WE WILL CALL REDST0 WITH DUMP MODE COMMAND WORD CNT IN RH(A).
REDST0 CLOBBERS: A,B,W,X,Y,Z.
WE NEED TO PRESERVE (BY THE TIME WE RETURN): E, THISTY.
AC USAGE IN LOOP(S) BELOW:
C CURRENT CHAR FROM STORY.
E PTR TO CURRENT STORY LIST ENTRY.
L NUMBER OF LINES LEFT FOR CURRENT STORY.
M NUMBER OF SPACES LEFT ON CURRENT LINE.
R BYTE POINTER INTO STORY BEING BUILT.
Q BYTE POINTER INTO STORY BEING SUMMARIZED.
TMP2B BIT MEANS LAST CHAR PUT INTO STORY WAS A SPACE.
end of comment ⊗
MOVE R,[POINT 7,DATA]
HLRZ A,DATA+2 ;LENGTH OF DAT FILE
SKIPE DATIN ;ANY DAT FILE THERE?
ADDI R,(A) ;YES, PUT HEADLINE STORY AFTER IT
HRLZM R,HEADIN ;BEGINNING ADDRESS OF HEADLINE STORY
SETZM THISTY
REDHE3: HRRZ E,STYLST(E) ;NEXT STORY IN STORY LIST
JUMPE E,REDHEX
MOVE A,THISTY
IMUL A,ALINES ;NUMBER OF LINES GENERATED SO FAR
ADD A,THISTY ;NUMBER OF BLANK LINES BETWEEN STORIES
CAIL A,=150-12 ;ENOUGH LINES LEFT FOR NEXT STORY?
JRST REDHEY ;NO, PUT OUT ...CRLF
SKIPE ESCIFG
JRST REDHEZ
JUMPE A,REDHE2 ;PUT OUT BLANK LINE UNLESS FIRST STORY
MOVEI C," "
IDPB C,R
MOVEI C,CR ;BLANK LINE BETWEEN STORY SUMMARIES
IDPB C,R
MOVEI C,LF
IDPB C,R
REDHE2:
;140=1+2+8*(84+2)/5 IS THE MAX AMOUNT OF CORE NEEDED PER STORY SUMMARY (2=CR+LF)
MOVEI A,=140(R) ;POTENTIAL END ADDRESS OF STORY SUMMARY
CAMG A,JOBREL↑ ;GOT THAT MUCH CORE?
JRST .+3 ;YES
CORE A, ;NO
UFATAL 524 ;;;CANT GET ENOUGH CORE
MOVE L,ALINES ;NUMBER OF LINES/STORY
MOVE M,LINLEN ;LENGTH OF EACH LINE
IFE DEBUG <
SUBI M,4+1+2+1 ;A101, SPACE, DAY, SPACE
>
IFN DEBUG <
SUBI M,4+1+4+1+2+1 ;A101, SPACE, TIME(4), SPACE, DAY(2), SPACE
>
AOS A,THISTY ;NEXT STORY NUMBER
CAIE A,=10 ;10TH STORY?
CAIN A,=100 ;OR 100TH?
SOSA D,NSPC1# ;YES, ONE LESS PADDING SPACE ON 1ST LINE FROM NOW ON
MOVE D,NSPC1#
PUSHJ P,DECOU1 ;PUT STORY NUMBER INTO HEADLINE STORY
MOVEI C," "
IDPB C,R ;PAD STORY NUMBER WITH SPACES
SOJG D,.-1
MOVNI A,400 ;ALWAYS READ IN SAME (THIS) AMOUNT
PUSHJ P,REDST0 ;READ IN FIRST FEW WORDS OF STORY
SETZM BUF+400 ;MAKE SURE STORY IS DELIMITED
MOVE Q,STYBEG ;PTR TO BEGINNING OF STORY
HRLI Q,440700 ;BYTE POINTER
MOVEI A,5
ILDB C,Q ;CHAR FROM STORY SEQ NBR
IDPB C,R
SOJG A,.-2
IBP Q ;SKIP 2ND SPACE AFTER SEQ NBR
IFN DEBUG <
MOVEI A,5
ILDB C,Q ;CHAR FROM TIME(4) OR SPACE
IDPB C,R
SOJG A,.-2
>
IFE DEBUG <
ADDI Q,1 ;SKIP OVER 5 CHARS: TIME (4), SPACE
>
IBP Q ;SKIP 2ND SPACE AFTER TIME
MOVEI A,3
ILDB C,Q ;CHAR FROM DATE
IDPB C,R
SOJG A,.-2
ADDI Q,1 ;SKIP 5 CHARS: MONTH(3), SPACE, YEAR(1)
ILDB C,Q ; THEN IGNORE YEAR(1), CRLF
JUMPE C,REDHE8
CAIE C,LF ;SKIP TO END OF 1ST LINE OF STORY
JRST .-3
TLO F,TMP2B ;LAST CHAR IN HEADLINE STORY WAS A SPACE
MOVEM Q,QOLD ;SAVE BYTE PTRS TO LAST SPACE PUT OUT
MOVEM R,ROLD
REDHE4: ILDB C,Q
JUMPE C,REDHE7 ;END OF STORY?
REDHE5: CAIE C,CR ;NO
CAIN C,LF
SKIPA C,[" "] ;CHANGE CR AND LF INTO SPACES
CAIN C," " ;SPACE?
JRST [TLOE F,TMP2B ;YES, PREVIOUS CHAR A SPACE?
JRST REDHE4 ;YES, IGNORE CURRENT SPACE
MOVEM Q,QOLD# ;NO, SAVE BYTE PTRS TO THIS SPACE
MOVEM R,ROLD#
JRST REDHE6] ;NO, PUT OUT SPACE
TLZ F,TMP2B ;NO SPACE SEEN RECENTLY
REDHE6: IDPB C,R ;PUT CHAR INTO HEADLINE STORY
SOJGE M,REDHE4 ;OUTPUT LINE COMPLETE?
CAIE C," " ;OVERFLOW OF LINE CAUSED BY SPACE?
JRST [SKIPN Q,QOLD ;NO, BACK UP TO LAST SPACE PUT OUT
JRST REDHE7 ;NO SPACES PUT OUT ON THIS LINE! ABANDON THIS STORY.
MOVE R,ROLD
IBP R ;INSERT CRLF HERE
JRST .+1]
SETZM QOLD
MOVEI C,CR ;PUT OUT CRLF
DPB C,R
MOVEI C,LF
IDPB C,R
SOJLE L,REDHE3 ;ENOUGHT LINES FOR THIS STORY?
ILDB C,Q ;NO
JUMPE C,REDHE3 ;END OF STORY?
MOVEI A," " ;NO
MOVE B,NSPC2#
IDPB A,R ;INDENT NEXT LINE
SOJG B,.-1
TLO F,TMP2B
MOVE M,LINLEN ;LENGTH OF NEXT LINE
JRST REDHE5
REDHE7: LDB C,R ;GET LAST CHAR
CAIN C,LF ;END WITH LF?
JRST REDHE3 ;YES
REDHE8: MOVEI C,CR ;NO, ADD CRLF
IDPB C,R
MOVEI C,LF
IDPB C,R
JRST REDHE3 ;NEXT STORY
REDHEZ: OUTSTR [ASCIZ\
MANUAL INTERRUPTION. HEADLINE STORY INCOMPLETE.\] ;ESC I TYPED
TLZ F,IFILB
SETZM ALINES ;THIS FORCES XHEADLI COMMAND TO MAKE NEW HEADLINES
REDHEY: MOVEI C,"." ;TOO MANY STORIES. PUT ...CRLF AT END OF STORY
IDPB C,R
IDPB C,R
IDPB C,R
MOVEI C,CR
IDPB C,R
MOVEI C,LF
IDPB C,R
REDHEX: SETZ A,
IDPB A,R
TLNE R,760000 ;FILL OUT LAST WORD WILL NULLS
JRST .-2
MOVEI R,1(R) ;PTR TO WORD BEYOND END OF STORY
IORB R,HEADIN ;BEGINNING,,END OF STORY
MOVE E,CURREN ;RESTORE PTR TO STORY LIST ENTRY FOR HEADLINE STORY
SETZM THISTY ;NUMBER OF HEADLINE STORY
REDHE9: HRRZM R,STYEND ;PTR TO END OF STORY
HLRZM R,STYBEG ;PTR TO BEGINNING OF STORY
JRST CPOPJ1 ;SUCCESS RETURN FROM REDSTY
;REVCUR INSHED
REVCUR: SKIPE FCURR ;HEADLINE STORY IN LIST?
JRST REVCU0 ;NO
SETZM HEADIN ;FORCE HEADLINE STORY TO BE RECONSTRUCTED
HRRZ B,CURREN ;GET PTR TO HEADLINE ENTRY IN STORY LIST
JUMPE B,CPOPJ
HRRZ A,STYLST(B) ;GET PTR TO FIRST REAL STORY IN LIST
JUMPE A,CPOPJ ;THIS CAN'T BE ZERO, I THINK, BUT BETTER SAFE ...
HRRZS STYLST(A) ;MAKE FIRST STORY END (BEGINNING) OF LIST
HRRM A,CURREN ;MAKE HEADER POINT TO FIRST REAL STORY
PUSHJ P,REVCU0 ;REVERSE REAL PART OF LIST
;NOW WE INSERT THE HEADLINE STORY'S ENTRY INTO THE STORY LIST AT THE FRONT
INSHE1: HRRZ A,CURREN ;PTR TO NEW FIRST STORY
JUMPE A,CPOPJ ;MAKE SURE THERE IS A LIST THERE
MOVEM A,STYLST(B) ;PTR FORWARD PTR AND NULL BACKWARD PTR IN HEADLINE ENTRY
HRLM B,STYLST(A) ;MAKE FIRST ENTRY POINT BACK TO HEADLINE ENTRY
HRRM B,CURREN ;MAKE HEADER POINT TO HEADLINE ENTRY
POPJ P,
REVCU0: MOVSS A,CURREN ;REVERSE ORDER OF CURRENT STORY LIST
JUMPE A,CPOPJ ;NULL LIST IS SIMPLE
REVCU1: MOVSS A,STYLST(A) ;INTERCHANGE FORWARD AND BACKWARD PTRS
TRNE A,-1 ;END OF LIST?
JRST REVCU1 ;NO
POPJ P,
INSHED: HRRZ B,STYLST ;GET FREE SLOT
JUMPE B,INSHER ; (IF ANY)
SETZM FCURR ;HEADLINE STORY WILL BE FIRST STORY, NUMBER 0 IN LIST
HRRZ A,STYLST(B) ;PTR TO SECOND SLOT
MOVEM A,STYLST ;NEW FREE LIST HEADER
SETZM STYPTR(B) ;MARK AS HEADLINE STORY
SETZM STYFOL(B)
SETZM STYTIM(B)
JRST INSHE1
INSHER: OUTSTR [ASCID / NO STORY LIST SPACE FOR HEADLINE STORY.
/]
MOVEI A,1
MOVEM A,FCURR
POPJ P,
;REDSTY REDST0
;ROUTINE TO READ IN THE TEXT OF A STORY
;CALL:
; MOVE E,[<ptr to story list entry for story desired>]
; PUSHJ P,REDSTY
; <failure return>
; <success return>
;clobbers ACs A,B,W,X,Y,Z
REDSTY: HLRE A,STYPTR(E) ;PICK UP NEGATIVE DUMP MODE WORD COUNT
JUMPE A,REDHED ;CREATE HEADLINE STORY
REDST0: HRLM A,TXTCMD ;STORE DUMP MODE WORD COUNT IN DUMP MODE COMMAND
SUBI A,BUF ;MAKE NEGATIVE PTR TO WORD BEYOND END OF STORY
MOVNM A,STYEND ; AND SAVE POSITIVE PTR
CAMG A,[-<BUF+LBUF-=20>]
JRST REDST3 ;STORY TOO BIG TO FIT IN BUFFER
HRRZ A,STYPTR(E) ;PICK UP PTR TO LOCATION OF STORY WITHIN TXT FILE
SETZB B,HNGTIM
LSHC A,-7 ;SHIFT DISPLACEMENT WITHIN RECORD INTO AC B
ROT B,7
ADDI B,BUF ;MAKE POINTER TO FIRST WORD IN STORY
MOVEM B,STYBEG ; AND SAVE IT
OPEN TXT,DSK17
UFATAL 530 ;;;CANT OPEN DSK
HLRZ W,STYTIM(E) ;PICK UP DATE OF STORY
MOVSI X,'TXT'
HLRZ Z,STYFOL(E) ;CODE OF WIRE SERVICE
MOVE Z,WIRES(Z) ;PPN OF PARTICULAR WIRE
REDST1: LOOKUP TXT,W
JRST WAITXT ;LOOKUP FAILED--WAIT AND THEN TRY AGAIN
USETI TXT,1(A)
IN TXT,TXTCMD
AOS (P) ;SUCCESS RETURN
REDST2: RELEAS TXT,
POPJ P,
REDST3: OUTSTR [ASCIZ\
STORY TOO LONG -- \]
POPJ P,
WAITXT: AOS B,HNGTIM
CAILE B,=15
JRST REDST2 ;GIVE UP AFTER 15 SECONDS
MOVEI B,1
SLEEP B, ;WAIT ONE SECOND
JRST REDST1 ;THEN TRY AGAIN
;GETSTY
;ROUTINE TO READ IN A STORY AND PROCESS IT IN PREPARATION FOR DISPLAYING/TYPING
GETSTY: TLZ F,STYB!HDRB
PUSHJ P,REDSTY ;READ IN THE STORY
JRST STYERR
TLO F,STYB ;HAVE STORY IN CORE NOW
MOVE Q,STYBEG
HRLI Q,440700 ;MAKE BYTE POINTER TO BEGINNING OF STORY
MOVE A,SUBSTY ;NUMBER OF CURRENT SUBSTORY
MOVEI R,HDRP1
SKIPGE HDRP0 ;ANY SUBSTORIES?
PUSHJ P,DPYNUM ;YES. PUT DISPLAY TEXT INTO HEADER FOR STORY.
TLNN F,TMP1B ;ARE WE DISPLAYING STORIES?
JRST GETST2 ;NO, TYPING
MOVE A,STYBEG ;BEGINNING OF STORY
SUB A,STYEND ;NEGATIVE LENGTH OF STORY
MOVSI A,(A)
HRR A,STYBEG ;MAKE AOBJN PTR TO STORY
MOVEI B,1
ORM B,(A) ;MAKE DISPLAY TEXT WORDS
AOBJN A,.-1
SETO B,
MOVEM Q,FREND
JRST CTLFS1
CTLFS0: SOJG C,CTLFS
ADDI B,1
CAILE B,MAXFRS
UFATAL 534 ;;;STORY HAS TOO MANY FRAMES (TOO MANY LINES)
MOVEM Q,FREND+1(B)
CTLFS1: MOVE C,FRSIZE ;NUMBER OF LINES PER FRAME
CTLFS: ILDB A,Q ;GET CHAR FROM STORY
CAIN A,LF ;END OF LINE?
JRST CTLFS0 ;YES
JUMPN A,CTLFS ;NO. END OF STORY?
HRLI Q,010700 ;ADVANCE BYTE PTR TO END OF WORD
MOVE A,[ASCID /*****/];PUT ROW OF STARS AT END OF STORY
MOVEM A,1(Q)
MOVEM A,2(Q)
MOVEM A,3(Q)
MOVE A,[ASCID /***
/]
MOVEM A,4(Q)
ADDI Q,4
CAMN C,FRSIZE ;PARTIAL FRAME IN PROGRESS?
JUMPG B,[SOJA B,CTLFS7];NO--JUMP UNLESS FIRST FRAME
CTLFS6: MOVE A,[BYTE (7)40,15,12,0,0 (1)1]
ADDI Q,1
MOVEM A,(Q)
SOJG C,.-2
CTLFS7: MOVEM Q,FREND+2(B) ;SAVE PTR TO END OF FRAME
JUMPGE B,CTLFS8
MOVE C,FRSIZE ;ADD WHOLE NEW BLANK FRAME
AOJA B,CTLFS6
GETST2: MOVEI C,LSHORT ;NUMBER OF STORY LINES IN PREVIEW
TDZA B,B ;FRAME NUMBER COUNTER
GETST3: ADDI B,1
CAIL B,MAXFRS ;RUNNING OUT OF FRAMES?
MOVEI C,-1 ;YES, PUT ALL REMAINING LINES IN THIS FRAME
GETST4: ILDB A,Q
CAIE A,CR
JUMPN A,GETST4 ;GET NEXT CHAR FROM STORY, IF ANY
JUMPE A,GETST5 ;JUMP IF AT END OF STORY
SOJG C,GETST4 ;FOUND END OF LINE, JUMP UNLESS AT END OF FRAME
MOVEM Q,FREND+1(B)
ILDB A,Q ;PICK UP LF AFTER CR
ILDB A,Q ;SECOND CHAR AFTER CR
MOVE C,TTSIZE ;NUMBER OF LINES/FRAME FOR TTY
JUMPN A,GETST3 ;JUMP UNLESS END OF STORY
GETST5: MOVEM Q,FREND+1(B) ;INCLUDE CRLF IN LAST FRAME
CTLFS8: MOVEM B,LASTFR
POPJ P,
STYERR: OUTSTR [ASCIZ /SORRY -- FAILED TO READ IN STORY. /]
POPJ P,
;SHOW SMAIN DISTAB ILLCMD
comment ⊗ IN THIS LOOP, THE FOLLOWING CELLS HAVE THESE VALUES:
cell value
E PTR TO CURRENT STORY LIST ENTRY
NCURR NUMBER OF STORIES IN MAIN STORY LIST (NOT COUNTING HEADLINE STORY)
THISTY NUMBER OF THE CURRENT STORY IN MAIN STORY LIST (BETWEEN 0 AND NCURR)
NPARTS NUMBER OF PARTS IN SUBSTORY LIST FOR CURRENT STORY
SUBSTY NUMBER OF THE CURRENT PART (BETWEEN 1 AND NPARTS)
L NUMBER OF CURRENT FRAME WITHIN CURRENT PART
ROUTINES DISPATCHED TO THROUGH DISTAB CAN RETURN TO EXPR LEVEL BY DOING A
JRST QUIT
end of comment ⊗
SHOW: SKIPN A,NCURR ;GET NUMBER OF STORIES IN CURRENT STORY LIST
POPJ P, ;NULL LIST
MOVEI R,HDRS2
PUSHJ P,DPYNUM
TLZ F,TMP1B ;ASSUME NOT DISPLAYING STORIES
SKIPGE F,LINTYP ;-1 IS TTY. 0 IS DD. 0,,-1 IS III.
JRST SMAIN0 ;TELETYPE
TRNE F,DPYB ;SKIP IF NOT IN DPY MODE
TLOA F,TMP1B ;DISPLAY STORIES
PUSHJ P,DPYEND ;TELETYPE MODE (DPYEND ALWAYS SKIPS)
PUSHJ P,DPYINI ;SELECT AND POSITION THE DPY'S PIECE OF PAPER
SMAIN0: PUSHJ P,TOBEG ;GET FIRST STORY IN LIST
TLNN F,TMP1B ;SKIP IF DISPLAYING
JRST STTY ;TYPING
MOVE A,[ASCID/DL/]
MOVEM A,HDRDL
SMAIN: OUTSTR [ASCIZ / ./] ;HERE IF DISPLAYING STORIES INSTEAD OF TYPING THEM
SETZM ARG
SMAIN1: SNEAKS C, ;ANY TYPE-AHEAD?
PUSHJ P,PRESEN ;NO, DISPLAY STORY IF NECESSARY
INCHRW A ;READ NEXT COMMAND
PUSHJ P,GETDPY ;FIND OUT WHAT KIND OF DPY WE ARE ON
MOVE C,A
LDB D,[POINT 2,C,28];PICK UP CONTROL BITS
ANDI C,177 ; AND CLEAR THEM
MOVE A,DISTAB(C)
PUSHJ P,(A) ;DISPATCH TO COMMAND ROUTINE
JRST SMAIN ;DIRECT RETURN FROM ROUTINE
JRST SMAIN1
STTY: PUSHJ P,PRESEN ;TYPE OUT STORY IF NECESSARY
STTY2: PUSHJ P,READ ;READ IN COMMAND
PUSHJ P,INNBR ;PICK UP ANY ARGUMENT
MOVEM B,ARG ; AND STORE IT
SKIPGE A,DISTAB(C) ;DISPATCH ADDRESS
JRST STTY4 ;COMMAND WITH ARGUMENT
PUSHJ P,GETCH ;NEXT NON-BLANK CHAR
JUMPE C,STTY4 ;COMMAND MUST END WITH NULL OR CR
CAIN C,CR
JRST STTY4 ;DISPATCH
STTY3: PUSHJ P,ILLCMD ;ILLEGAL COMMAND
JRST STTY2
STTY4: SETZ D, ;NO CONTROL BITS HERE
PUSHJ P,(A) ;EXECUTE COMMAND
JRST STTY
JRST STTY3 ;COMMAND ILLEGAL ON TTY
ILLCMD: OUTSTR CRLF
OUTSTR SORRY
OUTSTR [ASCIZ /UNRECOGNIZED COMMAND -- /]
CAIN C,TAB
JRST [OUTSTR [ASCIZ/<tab>/]
JRST ILL1]
CAIN C,177
JRST [OUTSTR [ASCIZ/<backspace>/]
JRST ILL1]
OUTCHR C
ILL1: OUTSTR [ASCIZ/ -- Type Q if you wish to
return to keyword level./]
CLRBFI
TLNN F,TMP1B
OUTSTR [ASCIZ / ./]
POPJ P,
ILL←←<400000,,ILLCMD>
DISTAB: ILL ;000 NULL
ILL ;001 ↓
ILL ;002 α
ILL ;003 β
ILL ;004 ∧
ILL ;005 ¬
ILL ;006 ε
ILL ;007 π
ILL ;010 λ
ILL ;011 TAB
PREST1 ;012 LF
PFRAMX ;013 VT
NFRAMX ;014 FF
PREST ;015 CR
ILL ;016 ∞
ILL ;017 ∂
ILL ;020 ⊂
ILL ;021 ⊃
ILL ;022 ∩
ILL ;023 ∪
ILL ;024 ∀
ILL ;025 ∃
ILL ;026 ⊗
ILL ;027 ↔
ILL ;030 _
ILL ;031 →
ILL ;032 ~
ILL ;033 ≠
ILL ;034 ≤
ILL ;035 ≥
ILL ;036 ≡
ILL ;037 ∨
ILL ;040 SPACE
ILL ;041 !
ILL ;042 "
ILL ;043 #
ILL ;044 $
ILL ;045 %
ILL ;046 &
ILL ;047 '
ILL ;050 (
ILL ;051 )
ILL ;052 *
ILL ;053 +
PFRAME ;054 ,
ILL ;055 -
ILL ;056 .
ILL ;057 /
GETARG ;060 0
GETARG ;061 1
GETARG ;062 2
GETARG ;063 3
GETARG ;064 4
GETARG ;065 5
GETARG ;066 6
GETARG ;067 7
GETARG ;070 8
GETARG ;071 9
ILL ;072 :
ILL ;073 ;
ILL ;074 <
ILL ;075 =
ILL ;076 >
QUEST ;077 ?
ILL ;100 @
ILL ;101 A
ILL ;102 B
ILL ;103 C
ILL ;104 D
XIT0 ;105 E
ILL ;106 F
ILL ;107 G
ILL ;110 H
PSTORY ;111 I
NPART ;112 J
PPART ;113 K
ILL ;114 L
NFRAME ;115 M
ILL ;116 N
ILL ;117 O
ILL ;120 P
QUIT ;121 Q
ILL ;122 R
ILL ;123 S
ILL ;124 T
NSTORY ;125 U
REDRAW ;126 V
ILL ;127 W
400000,,XCOMM ;130 X
ILL ;131 Y
ILL ;132 Z
ILL ;133 [
ILL ;134 \
ILL ;135 ]
ILL ;136 ↑
ILL ;137 ←
ILL ;140 '
ILL ;141 a
ILL ;142 b
ILL ;143 c
ILL ;144 d
XIT0 ;145 e
ILL ;146 f
ILL ;147 g
ILL ;150 h
PSTORY ;151 i
NPART ;152 j
PPART ;153 k
ILL ;154 l
NFRAME ;155 m
ILL ;156 n
ILL ;157 o
ILL ;160 p
QUIT ;161 q
ILL ;162 r
ILL ;163 s
ILL ;164 t
NSTORY ;165 u
REDRAW ;166 v
ILL ;167 w
400000,,XCOMM ;170 x
ILL ;171 y
ILL ;172 z
ILL ;173 {
ILL ;174 |
NOARG ;175 ALTMODE
ILL ;176 }
ILL ;177 BACKSPACE
;PRESEN PRETTY
;ROUTINE TO TYPE OUT OR DISPLAY A STORY
PRESEN: TLZE F,DISPLB ;NEED TO PRESENT STORY?
TLNN F,STYB ;ANYTHING THERE TO PRESENT?
POPJ P, ;NO
TLNN F,TMP1B ;DISPLAY OR TYPE OUT?
JRST PRETTY ;TYPE OUT
TLOE F,HDRB ;DO WE NEED TO DISPLAY HEADER LINE NOW?
JRST PRED0 ;NO
SKIPE LINTYP ;SKIP IF DD
JRST .+4
MOVE B,DDCOMW
MOVEM B,HDRPRG
SKIPA B,DDHDRP
MOVE B,IIHDRP
MOVEM B,HDRPRG+1
UPGIOT 1,HDRHDR ;DISPLAY HEADER LINE ABOVE STORY
PRED0: MOVE A,FREND(L) ;BYTE PTR TO BEGINNING OF FRAME OF INTEREST
MOVE C,FREND+2(L) ;BYTE PTR TO END OF SECOND FRAME OF INTEREST
PUSH P,-2(A)
PUSH P,-1(A)
PUSH P,(A)
PUSH P,(C)
PUSH P,1(C)
setzm -2(a); goddamn system should know this word will not be executed by iii processor
SKIPE LINTYP ;SKIP IF DD
JRST .+4
MOVE B,DDCOMW
MOVEM B,-2(A) ;PLACE DD COMMAND WORD IN DPY PROGRAM
SKIPA B,DDFRMP
MOVE B,IIFRMP
MOVEM B,-1(A) ;PLACE DD OR III POSITION WORD IN DPY PROGRAM
MOVEI B,-2(A)
HRRM B,DDHDR ;ADDRESS OF DPY PROGRAM
ADDI B,1
MOVEM B,DDHDR+3 ;ADDRESS OF DD LOLIN COMMAND FOR DOUBLE-FIELD MODE
SUBI B,3(C)
MOVNM B,DDHDR+1 ;LENGTH OF DPY PROGRAM
SETZ B, ;CLEAR BYTES JUST BEFORE FIRST LINE OF FRAME
PRED1: DPB B,A
ADD A,[070000,,0] ;BACK UP BYTE PTR ONE BYTE
JUMPGE A,PRED1
JRST PRED3
PRED2: IDPB B,C ;CLEAR BYTES JUST AFTER LAST LINE OF FRAME
PRED3: TLNE C,760000 ;AT END OF WORD?
JRST PRED2 ;NO
;NOW WE TAKE CARE OF THE ROW OF DASHES AT BOTTOM OF SCREEN
SKIPE LINTYP ;SKIP IF DD
JRST [CAME L,LASTFR
JRST PRED4
PGACT 677770 ;LAST FRAME, DISABLE DASHES ON III, ALSO RAID
JRST PRED5]
CAMN L,LASTFR
JRST PRED5 ;LAST FRAME, NO DASHES NEEDED FOR DD
MOVE B,DDCOMW
MOVEM B,TRLPRG
SKIPA B,DDTRLP
PRED4: MOVE B,IITRLP
MOVEM B,TRLPRG+1
UPGIOT 2,TRLHDR ;DISPLAY DASHES AT BOTTOM OF SCREEN
PRED5: SETZM 1(C) ;DD HALT INSTRUCTION AT END OF DPY PROGRAM
UPGIOT DDHDR ;DISPLAY FRAME OF STORY
POP P,1(C)
POP P,(C)
POP P,(A)
POP P,-1(A)
POP P,-2(A)
POPJ P,
;HERE TO TYPE OUT A STORY
;L IS NUMBER OF FRAME TO BE TYPED OUT
PRETTY:
JUMPN L,PRETT2
MOVE Q,FREND+1
PUSH P,(Q) ;SAVE TEXT ABOUT TO BE CLOBBERED
SETZ A,
DPB A,Q ;PUT NULL BYTE AT END OF PREVIEW TEXT
OUTSTR CRLF
OUTSTR HDRPRG+4 ;......STORY_
OUTSTR HDRS1 ;1
OUTSTR HDRS3 ;_OF_
OUTSTR HDRS2 ;9
SKIPGE HDRP0
OUTSTR HDRS2+1 ;....
OUTSTR HDRP0 ;PART_1
OUTSTR HDRP3 ;_OF_
OUTSTR HDRP2 ;3
OUTSTR HDRP2+3 ;......
OUTSTR @STYBEG ;TYPE OUT FIRST FEW LINES OF STORY
POP P,(Q) ;RESTORE ORIGINAL TEXT
JRST PRETT3
PRETT2: MOVE Q,FREND(L) ;PTR TO BEGINNING OF FRAME
IBP Q ;ADVANCE BYTE PTR TO LF AFTER CR FOLLOWING PREVIEW
TLZ Q,7777 ;MAKE TTYMES RUN TO NULL BYTE
MOVEM Q,TTMS+1
PUSH P,@FREND+1(L) ;SAVE TEXT ABOUT TO BE CLOBBERED
SETZ A,
DPB A,FREND+1(L) ;PUT NULL BYTE AT END OF FRAME
MOVEI Q,TTMS
TTYMES Q, ;TYPE OUT REMAINDER OF STORY
JFCL ;CAN'T HAPPEN
POP P,@FREND+1(L) ;RESTORE TEXT
PRETT3: INSKIP ;CLEAR ↑O
JFCL
CAMN L,LASTFR ;LAST FRAME OF STORY?
JRST PRETT4 ;YES
OUTSTR [ASCIZ / ./] ;NO
POPJ P,
PRETT4: MOVEI Q,[ASCIZ /********/]
MOVE A,SUBSTY
CAME A,NPARTS ;LAST PART OF STORY?
MOVEI Q,[ASCIZ /--------/] ;NO
OUTSTR (Q)
POPJ P,
;NFRAME PFRAME NPART PPART NSTORY PSTORY DOCNT SETDSP TOEND TOBEG PREST
;;;HERE ARE THE ROUTINES TO ADVANCE IN FRAMES, PARTS, STORIES
PREST1: OUTCHR [CR]
PREST: TLNN F,TMP1B ;DISPLAYING?
JRST NFRAME ;NO, TYPE OUT NEXT FRAME
CAIN C,CR ;CR TYPED ON DPY?
INCHWL C ;YES, READ LF FOLLOWING CR
POPJ P, ; BUT DON'T DO ANYTHING
NPART1: CAML A,NPARTS ;ALREADY LOOKING AT LAST PART?
POPJ P, ;YES
JRST NPART3 ;NO
NPART2: SKIPN B,ARG ;ADVANCE SOME NUMBER OF PARTS
MOVEI B,1 ;NO ARG, ADVANCE 1 PART
ADDI B,(A) ;FINAL PART NUMBER
CAMLE B,NPARTS ;PART NUMBER TOO HIGH?
NPART3: MOVE B,NPARTS ;YES, GIVE HIM LAST PART
MOVEM B,SUBSTY ;SAVE SUBSTORY NUMBER
SUBI B,(A) ;NUMBER OF PARTS WE NEED TO ADVANCE
CAIN A,1 ;GOT FIRST PART NOW?
SKIPA E,STYFOL(E) ;YES, GET 2ND PART
MOVE E,STYLST(E) ;NEXT PART
SOJG B,.-1 ;ADVANCED FAR ENOUGH YET?
JRST GTST ;READ STORY IN AND DISPLAY FIRST FRAME
NFRAM1: CAMN L,LASTFR ;ALREADY LOOKING AT LAST FRAME?
POPJ P, ;YES, EASY
JRST NFRAM3 ;NOW WE ARE
NFRAM2: SKIPN B,ARG ;ANY ARGUMENT?
AOJA L,SETDSP ;NO, NEXT FRAME
ADDI L,(B) ;GET NUMBER OF FRAME WANTED
CAMLE L,LASTFR ;FRAME NUMBER TOO HIGH?
NFRAM3: MOVE L,LASTFR ;YES, GIVE HIM LAST FRAME
JRST SETDSP
;HERE ON FORMFEED
NFRAMX: CAML L,LASTFR ;IF ON LAST FRAME, SAME AS M
JRST NFRAME ;SAME AS M
SKIPN A,ARG ;ANY ARG?
TROA A,2 ;NO, USE ARG OF 2
LSH A,1 ;YES, MULTIPLY ARG BY 2
TLNE F,TMP1B ;DISPLAYING?
MOVEM A,ARG ;YES, USE SIMULATED ARG
NFRAME: JUMPN D,NFRAM1 ;IF ANY CONTROL BITS, ADVANCE TO LAST FRAME OF PART
CAMGE L,LASTFR ;LAST FRAME IN STORY YET?
JRST NFRAM2 ;NO, ADVANCE 1 OR MORE FRAMES
SKIPE ARG ;YES. ANY ARGUMENT?
JRST NOFRAM ;YES, NO FRAMES TO ADVANCE
NPART: MOVE A,SUBSTY ;NUMBER OF CURRENT PART
JUMPN D,NPART1 ;IF ANY CONTROL BITS, ADVANCE TO LAST PART OF STORY
CAMGE A,NPARTS ;LAST PART OF STORY YET?
JRST NPART2 ;NO, ADVANCE 1 OR MORE PARTS
SKIPE ARG ;YES. ANY ARGUMENT
JRST NOPART ;YES, NO PARTS TO ADVANCE
NSTORY: MOVE A,THISTY ;NUMBER OF CURRENT STORY IN MAIN LIST
CAML A,NCURR ;LAST STORY?
JRST NSTOR2 ;YES
JUMPN D,TOEND ;IF ANY CONTROL BITS, GET LAST STORY IN LIST
SKIPN B,ARG ;ANY ARGUMENT?
AOJA A,.+2 ;NO, NEXT STORY IN MAIN LIST
ADDI A,(B) ;YES, NUMBER OF STORY WANTED
CAML A,NCURR ;IS THERE SUCH A STORY?
JRST TOEND ;NO, GET LAST STORY
MOVEM A,THISTY ;YES
HRRE C,STYFOL(E) ;GET PTR TO ORIGINAL OF CURRENT STORY
JUMPGE C,.+2 ;JUMP IF ALREADY HAD ORIGINAL
MOVN E,C ;MAKE POSITIVE PTR TO ORIGINAL
MOVE E,STYLST(E) ;PTR TO NEXT STORY IN MAIN LIST
SOJG B,.-1 ;ADVANCED ENOUGH STORIES?
DOCNT0: PUSHJ P,DOCNT ;COUNT NUMBER OF SUBSTORIES FOR ORIGINAL
GTST: PUSHJ P,GETSTY ;READ IN STORY
SETZ L, ;PRESENT FIRST FRAME
HRRE A,STYFOL(E) ;PTR TO ORIGINAL
JUMPL A,.+2 ;JUMP IF HAVE FOLLOW-UP
SKIPA A,E ;HAVE ORIGINAL
MOVN A,A ;MAKE PTR TO ORIGINAL
HLRZ B,STYFOL(A) ;WIRE SERVICE CODE (AP,NYT,...)
ROT B,-3 ;PUT CODE IN HIGH ORDER 3 BITS
IOR B,STYTIM(A) ;DATE IN BITS 3:17
HRR B,STYPTR(A) ;PTR TO TEXT
MOVE A,SEEN ;NBR OF STORIES SEEN
CAMN B,SEEN(A) ;THIS STORY ALREADY IN LIST?
JRST SETDSP ;YES
SOJG A,.-2 ;LOOP THRU WHOLE LIST
AOS A,SEEN ;NEVER SEEN BEFORE
CAIG A,LSEEN ;TOO MANY STORIES SEEN?
MOVEM B,SEEN(A) ;NO, REMEMBER THIS ONE
SETDSP: TLO F,DISPLB ;MAKE SURE SCREEN GETS UPDATED
POPJ P,
NSTOR2: JUMPE D,QUIT ;UNLESS CONTROL BITS ON, RETURN TO EXPR LEVEL
POPJ P,
DOCNT: MOVEI A,1 ;COUNT NUMBER OF SUBSTORIES FOR NEW ORIGINAL
MOVEM A,SUBSTY ;NUMBER OF CURRENT SUBSTORY
SKIPA B,STYFOL(E) ;PTR TO FIRST FOLLOW-UP
DOCNT1: HRRZ B,STYLST(B) ;PTR TO NEXT FOLLOW-UP
TRNE B,-1 ;END OF LIST?
AOJA A,DOCNT1 ;NO
DOCNT4: MOVEM A,NPARTS ;STORE NUMBER OF SUBSTORIES
DOCNT5: CAIN A,1
JRST DOCNT3 ;NO SUBPARTS EXCEPT FOR ORIGINAL
MOVEI R,HDRP2
PUSHJ P,DPYNUM
MOVE A,[ASCID /PART /]
MOVEM A,HDRP0
MOVE A,HDRS3 ;[ASCID / OF /]
MOVEM A,HDRP3
DOCNT2: MOVE A,THISTY ;NUMBER OF CURRENT STORY
MOVEI R,HDRS1
JRST DPYNUM
DOCNT3: MOVEM A,HDRP0
MOVE A,[HDRP0,,HDRP0+1]
BLT A,HDRP2
JRST DOCNT2
TOEND: MOVE A,NCURR ;NUMBER OF LAST STORY IN MAIN LIST
MOVEM A,THISTY
MOVS E,CURREN ;PTR TO LAST STORY IN MAIN LIST
JRST DOCNT0 ;COUNT NUMBER OF SUBSTORIES FOR NEW ORIGINAL
;;;HERE ARE THE ROUTINES TO BACK UP IN FRAMES, PARTS, STORIES
PFRAM1: JUMPG L,PFRAM3 ;ALREADY GOT FIRST FRAME?
POPJ P, ;YES
PFRAM2: SKIPN B,ARG ;ANY ARGUMENT?
SOJA L,SETDSP ;NO, PREV FRAME
SUBI L,(B) ;YES, FRAME NUMBER WE WANT
JUMPGE L,SETDSP ;JUMP IF LEGAL FRAME NUMBER
PFRAM3: SETZ L, ;GET FIRST FRAME
JRST SETDSP
;HERE ON VERTICAL TAB
PFRAMX: JUMPLE L,PFRAME ;IF ON FIRST FRAME, SAME AS COMMA
SKIPN A,ARG ;ANY ARG?
TROA A,2 ;NO, USE ARG OF 2
LSH A,1 ;YES, MULTIPLY ARG BY 2
TLNE F,TMP1B ;DISPLAYING?
MOVEM A,ARG ;YES, USE SIMULATED ARG
PFRAME: JUMPN D,PFRAM1 ;IF ANY CONTROL BITS, BACKUP TO FIRST FRAME OF PART
JUMPG L,PFRAM2 ;JUMP IF NOT AT FIRST FRAME
SKIPE ARG ;ANY ARGUMENT
JRST NOFRAM ;YES, NO FRAMES TO BACKUP
PUSH P,E
PUSHJ P,PPART ;BACK UP ONE PART
POP P,A
CAMN E,A ;GOT NEW STORY?
JRST QUIT ;NO, RETURN TO EXPR LEVEL
MOVE L,LASTFR ;AND DISPLAY LAST FRAME
POPJ P,
PPART1: CAIN A,1 ;ALREADY GOT FIRST PART?
POPJ P, ;YES
JRST PPART3 ;NO, GET IT
PPART2: SKIPN B,ARG ;ANY ARGUMENT?
MOVEI B,1 ;NO, BACKUP 1 PART
SUBI A,(B) ;GET NUMBER OF SUBSTORY WE WANT
JUMPG A,.+2 ;LEGAL SUBSTORY NUMBER?
PPART3: MOVEI A,1 ;NO, GIVE FIRST SUBSTORY
MOVEM A,SUBSTY ;SAVE NEW SUBSTORY NUMBER
HRRE E,STYFOL(E) ;PTR TO ORIGINAL
MOVN E,E ;MAKE IT POSITIVE
SOJLE A,GTST ;JUMP IF WANT ORIGINAL
SKIPA E,STYFOL(E) ;PTR TO FIRST FOLLOW-UP
MOVE E,STYLST(E) ;PTR TO NEXT FOLLOW-UP
SOJG A,.-1 ;GOT RIGHT FOLLOW-UP YET?
JRST GTST ;YES
PPART: MOVE A,SUBSTY ;NUMBER OF SUBSTORY
JUMPN D,PPART1 ;IF ANY CONTROL BITS, BACKUP TO FIRST PART OF STORY
CAILE A,1 ;FIRST SUBSTORY?
JRST PPART2 ;NO, PREVIOUS SUBSTORY
SKIPE ARG ;YES. ANY ARGUMENT?
JRST NOPART ;YES, NO PARTS TO BACKUP
;NOW WE BACK UP TO PREVIOUS STORY, LAST PART
MOVE A,THISTY ;MAIN STORY NUMBER
CAMG A,FCURR ;FIRST STORY?
JRST QUIT ;YES, RETURN TO EXPR LEVEL
SOS THISTY ;NO, GET PREV STORY
MOVS E,STYLST(E) ;PTR TO PREV MAIN STORY
MOVEI A,1 ;COUNT NUMBER OF PARTS
SKIPA B,STYFOL(E) ;PTR TO FIRST FOLLOW-UP
PFRS2: MOVE B,STYLST(E) ;GET PTR TO NEXT FOLLOW-UP
EXCH B,E
TRNE E,-1 ;END OF LIST
AOJA A,PFRS2 ;COUNT ANOTHER PART
HRRZ E,B ;PTR TO LAST ELEMENT IN SUBSTORY LIST
MOVEM A,SUBSTY ;LAST PART
PUSHJ P,DOCNT4
JRST GTST ;READ IN STORY, PREPARE TO DISPLAY IT
PSTORY: MOVE A,THISTY ;NUMBER OF CURRENT STORY IN MAIN LIST
CAMG A,FCURR ;FIRST STORY?
JRST NSTOR2 ;YES, RETURN TO EXPR LEVEL UNLESS CONTROL BITS ON
JUMPN D,TOBEG ;IF ANY CONTROL BITS, BACKUP TO FIRST STORY IN LIST
SKIPN B,ARG ;ANY ARGUMENT?
SOJA A,.+2 ;NO, PREV STORY IN MAIN LIST
SUBI A,(B) ;NUMBER OF STORY WE WANT
CAMG A,FCURR ;IS THERE SUCH A STORY?
JRST TOBEG ;NO, GET FIRST STORY
MOVEM A,THISTY ;YES
HRRE C,STYFOL(E) ;GET PTR TO ORIGINAL OF CURRENT STORY
JUMPGE C,.+2 ;JUMP IF ALREADY HAD ORIGINAL
MOVN E,C ;MAKE POSITIVE PTR TO ORIGINAL
MOVS E,STYLST(E) ;PTR TO PREV STORY IN MAIN LIST
SOJG B,.-1 ;BACKED UP ENOUGH?
JRST DOCNT0 ;YES
TOBEG: MOVE A,FCURR ;NUMBER OF FIRST STORY IN MAIN LIST
MOVEM A,THISTY
MOVE E,CURREN ;PTR TO FIRST STORY IN MAIN LIST
JRST DOCNT0 ;COUNT NUMBER OF SUBSTORIES FOR NEW ORIGINAL
NOPART: OUTSTR [ASCIZ/ NO SUCH PART./]
JRST .+2
NOFRAM: OUTSTR [ASCIZ/ NO SUCH FRAME./]
TLNN F,TMP1B ;DISPLAYING?
OUTSTR [ASCIZ/ ./] ;NO
POPJ P,
;REDRAW XIT0 XIT QUIT TRYDDT QUEST HELPDP GETARG NOARG HELP
REDRAW: TLNN F,TMP1B ;ON DISPLAY?
JRST CPOPJ1 ;NO
PUSHJ P,DPYINI
TLZ F,HDRB ;MAKE SURE HDR LINE GETS DRAWN AGAIN
JRST SETDSP ;MAKE SURE SCREEN GETS UPDATED
XIT0: CAIN D,2 ;META?
JRST TRYDDT ;YES
TLNE F,TMP1B ;DISPLAYING?
CAIN D,3 ;YES, DOUBLE-BUCKY?
JRST XIT
POPJ P, ;NO
XIT: PUSHJ P,DPYEND
JFCL ;DPYEND ALWAYS SKIPS
EXIT 1,
TLNN F,TMP1B ;DISPLAYING?
POPJ P, ;NO
JRST REDRAW ;YES, REDRAW SCREEN
QUIT: PUSHJ P,PRESEN ;UPDATE DISPLAY IF NECESSARY
TLNN F,TMP1B ;DISPLAYING?
JRST MAIN0 ;NO
MOVE A,[ASCID /../] ;REPLACE "DL" WITH ".." IN HEADER LINE
MOVEM A,HDRDL
SKIPE LINTYP ;SKIP IF DD
JRST .+4
MOVE B,DDCOMW
MOVEM B,HDRPRG
SKIPA B,DDHDRP
MOVE B,IIHDRP
MOVEM B,HDRPRG+1
UPGIOT 1,HDRHDR ;DISPLAY HEADER LINE ABOVE STORY WITHOUT "DL"
JRST MAIN0
TRYDDT: HRRZ D,JOBDDT↑
JUMPE D,CPOPJ ;IF NO DDT, DO NOTHING
SKIPLE LINTYP ;SKIP UNLESS ON III
PGACT 0 ;TURN OFF ALL POGs
JRST (D)
QUEST: TLNE F,TMP1B
JRST HELPDP
OUTSTR COMMON
OUTSTR [ASCIZ ⊗
Each teletype-mode input must be ended with a CARRIAGE RETURN.
⊗]
POPJ P,
HELPDP: SKIPE LINTYP ;SKIP IF DD
JRST HLPIII
MOVE A,DDCOMW
MOVEM A,HLPPRG
SKIPA A,DDFRMP
HLPIII: MOVE A,IIFRMP
MOVEM A,HLPPRG+1
UPGIOT HLPHDR
POPJ P,
GETARG: SKIPE A,ARG
IMULI A,=10
ADDI A,-60(C)
MOVEM A,ARG
AOSA (P)
NOARG: SETZM ARG
POPJ P,
HELP: MOVEI A,DPYB
TDNE A,PERM ;PERMANENT DPY MODE FLAG ON?
SKIPGE B,LINTYP ;YES, ON DPY?
JRST HELP2 ;NO, TYPE OUT HELP MESSAGE
JUMPG B,HP2III ;JUMP IF III
MOVE A,DDCOMW
MOVEM A,HP2PRG
SKIPA A,DDFRMP
HP2III: MOVE A,IIFRMP
MOVEM A,HP2PRG+1
UPGIOT HP2HDR
POPJ P,
HELP2: OUTSTR COMMO2
POPJ P,
;XCOMM
XCOMM: TLNN F,TMP1B ;DISPLAYING?
JRST XCOMM1 ;NO
OUTSTR [ASCIZ / Command? /]
PUSHJ P,READ
XCOMM1: MOVE D,[-LXNAMS,,XNAMS];SET UP AOBJN PTR FOR FINDSW
PUSHJ P,FINDS0 ;SEARCH TABLE FOR COMMAND
JRST XCOME1 ;UNDEFINED COMMAND
JRST XCOME2 ;AMBIGUOUS COMMAND
CAIE C,CR ;MUST END WITH CR
JRST XCOMER
JRST @XDSP-XNAMS(D) ;DISPATCH TO ROUTINE
XCOME1: OUTSTR [ASCIZ /UNDEFINED/]
JRST XCOME3
XCOME2: OUTSTR [ASCIZ /AMBIGUOUS/]
XCOME3: OUTSTR [ASCIZ / COMMAND /]
XCOMER: OUTSTR [ASCIZ /ABORTED/]
TLNN F,TMP1B
OUTSTR [ASCIZ / ./]
POPJ P,
DEFINE XCMDS <
XXX HEADLINES,INHEAD
XXX DSTORY,DSTORY
XXX DPART,DPART
; XXX NOINPUT,NOINPU ;DISABLE READING FROM COMMAND FILE
; XXX INPUT,DOINPU ;ENABLE READING FROM COMMAND FILE
; XXX FILE,PUTFIL
; XXX LPT,PUTLPT
; XXX XGP,PUTXGP
; XXX CLOSE,CLSFIL
; XXX UNSPOOL,UNSPOO
>
DEFINE XXX(NAME,ADR,BITS) <
<SIXBIT /NAME/>
>
XNAMS: XCMDS
LXNAMS←←.-XNAMS
DEFINE XXX(NAME,ADR,BITS) <
BITS,,ADR
>
XDSP: XCMDS
;INHEAD DSTORY DPART PUTFIL PUTLPT PUTXGP CLSFIL UNSPOO
PUTFIL:
PUTLPT:
PUTXGP:
CLSFIL:
UNSPOO: POPJ P,
INHEAD: SKIPE HEADIN ;HEADLINE STORY ALREADY IN CORE?
SKIPN B,ARG ;YES, NON-ZERO ARG?
JRST INHEA1
CAILE B,=8 ;YES
MOVEI B,=8 ;MAX NUMBER OF LINES/STORY
CAME B,ALINES ;WANT TO CHANGE NUMBER OF LINES/STORY?
SETZM HEADIN ;YES, DISCARD HEADLINE STORY IN CORE
INHEA1: SKIPE FCURR ;ALREADY AN ENTRY FOR HEADLINE STORY?
PUSHJ P,INSHED ;NO, MAKE ONE
MOVE B,ARG
MOVEM B,HLINES
JRST TOBEG ;READ IN STORY, SET UP STORY NUMBERS
;DELETE CURRENT STORY FROM STORY LIST
DSTORY: HRRE A,STYFOL(E) ;SEE IF WE HAVE ORIGINAL STORY
JUMPGE A,.+2
MOVN E,A ;PTR TO ORIGINAL STORY
DSTOR0: HRRZ A,STYLST(E) ;PTR TO NEXT STORY
HLRZ B,STYLST(E) ;PTR TO PREV STORY
SETZM STYLST(E) ;FOR RELLST
JUMPE A,DSTOR1 ;JUMP IF NO NEXT STORY
HRLM B,STYLST(A) ;MAKE NEXT STORY ENTRY POINT TO PREV ENTRY
JUMPE B,DSTOR2 ;JUMP IF NO PREV STORY
HRRM A,STYLST(B) ;MAKE PREV STORY ENTRY POINT TO NEXT ENTRY
DSTOR3: MOVE C,E ;SET UP PTR FOR RELLST
HRL C,C ;SET UP BACK PTR FOR RELLST
MOVE E,A ;PTR TO NEW CURRENT STORY
PUSHJ P,RELLST ;FREE STORY LIST ENTRY FOR DELETED STORY
SOS A,NCURR ;UPDATE NUMBER OF STORIES IN CURRENT LIST
MOVEI R,HDRS2
PUSHJ P,DPYNUM
JRST DOCNT0 ;READ IN NEW CURRENT STORY
;DELETING LAST STORY IN LIST
DSTOR1: JUMPE B,QUIT ;IF DELETING ONLY STORY, THEN QUIT
SOS THISTY ;NEW CURRENT STORY IS ONE PREVIOUS TO DELETED STORY
HRLM B,CURREN ;NEW PTR TO LAST STORY
HLLZS STYLST(B) ;CLEAR FORWARD PTR FOR NEW LAST STORY
MOVE A,B ;PTR TO NEW CURRENT STORY
JRST DSTOR3
;DELETING FIRST STORY IN LIST
DSTOR2: HRRM A,CURREN ;NEW PTR TO FIRST STORY
SKIPE THISTY ;DELETING HEADLINE STORY?
JRST DSTOR3 ;NO
AOS FCURR ;YES, NO MORE HEADLINE STORY
AOS NCURR ;CANCEL OUT THE LATER "SOS NCURR"
AOS THISTY ;FIRST STORY IN LIST NOW
JRST DSTOR3
DPART: HRRE A,STYFOL(E) ;get ptr to original, or first follow-up
JUMPE A,DSTOR0 ;jump if have original without follow-up
JUMPG A,DPART1 ;jump if have original with follow-up
MOVN A,A ;ptr to original
HRRZ B,STYFOL(A) ;get first follow-up
CAIN B,(E) ;is that current follow-up?
JRST DPART2 ;YES
DPART3: HRRZ A,STYLST(B) ;next follow-up
CAIN A,(E) ;current follow-up?
JRST DPART4 ;YES
HRRZ B,STYLST(A) ;next follow-up
CAIE B,(E) ;current follow-up?
JRST DPART3 ;NO
MOVE B,A
DPART4: HRRZ A,STYLST(E) ;delete a middle part. ptr to next part
HRRM A,STYLST(B) ;store ptr to next part in prev part
DPART5: JUMPN A,DPART6 ;jump unless just deleted last part
MOVE A,B ;ptr to part we will present
SOS SUBSTY ;present previous part
DPART6: HRRZ B,STYLST ;free list header
HRRZM B,STYLST(E) ;make freed story list entry pt to old free list
HRRZM E,STYLST ;make new free list header pt to freed entry
MOVE E,A ;present new part
SOS A,NPARTS ;one less part for current story
PUSHJ P,DOCNT5 ;prepare story headings (part number)
JRST GTST ;read in new part and present it
DPART2: HRRZ B,STYLST(E) ;delete first follow-up. ptr to next follow-up
HRRM B,STYFOL(A) ;make original pt to next follow-up
EXCH A,B ;ptr to new current part in A, orig in B
JRST DPART5
DPART1: MOVE B,STYPTR(A) ;pick up data from first follow-up
MOVEM B,STYPTR(E) ; and put into original's entry
MOVE B,STYTIM(A) ;pick up time/date from first follow-up
MOVEM B,STYTIM(E) ; and put into original's entry
HRRZ B,STYLST(A) ;ptr to second follow-up
HRRM B,STYFOL(E) ;make new original pt to old second follow-up
JUMPE B,.+2 ;jump if no second follow-up
HRLM E,STYLST(B) ;make second follow-up pt back to new original
EXCH A,E ;ptr to new orig in A, to old first follow-up in E
JRST DPART6
;INFILE FREAD FGETCH INFILC
INFILC: TLNN F,IFILOB ;INPUT FILE OPEN?
JRST INFILD ;NO
TLNE F,NEGB ;disabling reading from file?
TLZA F,IFILB ;yes. DON'T READ NEXT COMMAND FROM FILE
TLO F,IFILB ;no. READ NEXT COMMAND FROM FILE
POPJ P,
INFILD: OUTSTR SORRY
OUTSTR [ASCIZ /NO INPUT COMMAND FILE OPEN./]
POPJ P,
INFLE1: OUTSTR [ASCIZ /IMPROPER FILENAME SPECIFICATION/]
JRST SWERR
INFLE2: TLNE F,TMP1B ;HERE FROM INITIALIZATION?
POPJ P, ;YES, DON'T TYPE OUT ERROR MESSAGE
PUSHJ P,PRFILE ;NO, TYPE OUT FILE NAME
OUTSTR [ASCIZ / -- DOES NOT CONTAIN "NS:" COMMAND.
/]
POPJ P,
INFLE3: TLNN F,TMP1B ;SKIP IF HERE FROM INITIALIZATION
JRST NOLOOK
POPJ P,
;INFILI: TLO F,TMP1B ;HERE FROM INITIALIZATION
; MOVE A,[DIFILE,,W]
; BLT A,Z ;PICK UP DEFAULT FILENAME
; JRST INFIL1
INFILE: TLZ F,TMP1B!IFILB!IFILOB ;NOT HERE FROM INITIALIZATION. NO FILE OPEN.
CAIN C,"="
PUSHJ P,GETCH ;SKIP OVER EQUALS SIGN
PUSHJ P,GETFIL ;YES, READ FILENAME
JRST INFLE1 ;IMPROPER FILENAME SPEC
CAIE C,CR ;FILENAME MUST BE FOLLOWED BY CR
JRST SWERR3
MOVE A,[FILEF,,W]
BLT A,Z ;COPY FILENAME INTO ACS
JUMPN W,.+2
MOVE W,DIFILE ;PICK UP DEFAULT FILE NAME
TLNN F,GOTEXT
MOVE X,DIFILE+1 ;PICK UP DEFAULT EXTENSION
INFIL1: INIT FLI,0
SIXBIT /DSK/
IBUF
UFATAL 540 ;;;CANT INIT DSK
MOVE C,Z ;SAVE PPN
LOOKUP FLI,W ;OPEN INPUT COMMAND FILE
JRST INFLE3
MOVE Z,C ;RESTORE PPN
MOVEI C,IBUFS
MOVEM C,JOBFF↑
INBUF FLI,NIBUFS ;SET UP INPUT BUFFER RING IN COMPILED-IN SPACE
JRST INFIL4 ;LOOK FOR "NS:" AT BEGINNING OF LINE IN FILE.
INFIL2: PUSHJ P,FGETCH ;GET CHAR FROM FILE
JRST INFLE2 ;NO COMMAND IN FILE
INFIL3: CAIE C,LF
JRST INFIL2
INFIL4: PUSHJ P,FGETCH
JRST INFLE2 ;EOF RETURN
CAIE C,"N"
JRST INFIL3
PUSHJ P,FGETCH
JRST INFLE2 ;EOF
CAIE C,"S"
JRST INFIL3
PUSHJ P,FGETCH
JRST INFLE2
CAIE C,":"
JRST INFIL3
TLO F,IFILOB!IFILB ;SUCCESS, MAKE US READ NEXT COMMAND FROM FILE
POPJ P,
FREAD: TLNN F,IFILB
JRST READ0 ;NO COMMAND FILE OPEN, READ FROM TTY
SETZM ESCIFG ;NO ESC-I TYPED YET
OUTSTR [ASCIZ /
@/]
MOVE B,[POINT 7,TYBUF]
MOVEM B,TYPNT#
FREAD1: PUSHJ P,FGETCH ;READ CHAR FROM FILE
JRST FREAD3 ;EOF
SKIPE ESCIFG
JRST READ0A
CAIE C,CR ;IGNORE CRs, LFs and TABs
CAIN C,LF
JRST FREAD1
CAIN C,TAB
JRST FREAD1
CAIN C,"," ;END OF COMMAND?
JRST FREAD3 ;YES
CAIN C,";" ;END OF COMMAND FILE INPUT
JRST FREAD2 ;YES
CAME B,TYEND ;FILLED UP BUFFER YET?
IDPB C,B ;no, put character into type-in buffer
JRST FREAD1
FREAD2: PUSHJ P,FGET0 ;RELEASE COMMAND FILE, NO MORE INPUT FROM IT
FREAD3: CAMN B,TYPNT ;ANY CHARS READ?
JRST READ0 ;NO, READ COMMAND FROM TTY
CAME B,TYEND ;FULL BUFFER?
JRST FREAD5
FREAD4: OUTSTR SORRY
OUTSTR [ASCIZ/COMMAND TOO LONG -- TRUNCATED: /]
TLZ F,IFILB ;DONT READ FROM FILE AGAIN AUTOMATICALLY
FREAD5: MOVEI C,CR ;YES
IDPB C,B ;PUT CR AT END OF COMMAND
MOVEM C,BRCHAR
SETZ C,
IDPB C,B ; FOLLOWED BY A NULL
OUTSTR TYBUF ;TYPE OUT COMMAND READ FROM FILE
OUTCHR [LF]
POPJ P, ;SUCCESS
FGETCH: SOSG IBUF+2 ;BUFFER USED UP?
IN FLI, ;YES
JRST FGET1
FGET0: RELEAS FLI, ;ASSUME EOF
TLZ F,IFILB!IFILOB ;NO MORE COMMANDS FROM FILE
POPJ P, ;DIRECT RETURN FOR EOF
FGET1: ILDB C,IBUF+1 ;GET CHAR FROM BUFFER
MOVE A,@IBUF+1 ;GET WHOLE WORD FROM BUFFER
TRNN A,1 ;SOS LINE NUMBER?
JRST FGET2 ;NO
MOVNI A,6 ;YES, SKIP 6 BYTES (LINE NUMBER + TAB)
ADDM A,IBUF+2 ;UPDATE BYTE COUNT
AOS IBUF+1 ;UPDATE BYTE PTR
ILDB C,IBUF+1 ;NEXT CHAR
FGET2: JUMPE C,FGETCH
CAIN C,FF ;IGNORE FORMFEEDS
JRST FGETCH
JRST CPOPJ1 ;SUCCESS RETURN
;OUTFIL OUTSW SPOOL XSPOOL
OUTSW: SIXBIT /REPLAC/
SIXBIT /EXTEND/
SIXBIT /ABORT/
LPTSW: SIXBIT /SPOOL/
XGPSW: SIXBIT /XSPOOL/
LOUTSW←←.-OUTSW
EXSDSP: EXSASK ;ASK HIM NOW WHAT TO DO
EXSREP ;REPLACE OLD FILE
EXSEXT ;EXTEND OLD FILE
EXSABT ;ABORT OUTPUT
;RH OF AC N WILL CONTAIN:
;0 IF NO SPECIAL ACTION SPECIFIED
;1 IF WANT TO REPLACE OLD FILE
;2 IF WANT TO EXTEND OLD FILE
;3 IF WANT TO ABORT IF OLD FILE EXISTS
;FLAGS IN LH OF N
LPTB←←1 ;SPOOL ON LPT
XGPB←←2 ;SPOOL ON XGP
DELB←←4 ;DELETE AFTER SPOOLING
XSPOOL: SKIPA N,[DELB!XGPB,,0];SPOOL ON XGP AND DELETE
SPOOL: MOVSI N,DELB!LPTB ;SPOOL ON LPT AND DELETE
SKIPN NCURR
JRST OUTER1 ;NULL STORY LIST
OPEN FLO,DSK17
UFATAL 546 ;;;CANT OPEN DSK
MOVE A,[DSFILE,,W]
BLT A,Y ;GET FILE NAME TO BE USED FOR SPOOLING FILE
SPOOL0: MOVE Z,USRPPN ;PUT FILE ON REAL (LOGGED IN) DISK AREA
LOOKUP FLO,W
TRNE X,-1 ;SKIP IF FILE DOES NOT EXIST
AOJA W,SPOOL0
SPOOL1: ENTER FLO,W
AOJA W,[TRNE W,7 ;DONT TRY ENTERS FOREVER
JRST SPOOL1
OUTSTR [ASCIZ/OUTPUT FILE: /]
JRST NOENTR]
MOVE Z,USRPPN
MOVE A,[W,,OFILE]
BLT A,OFILE+3 ;SAVE NAME OF OUTPUT FILE
OUTSTR [ASCIZ/Creating file: /]
PUSHJ P,PRFILE
SETZM AMT ;NO LEFT-OVER TEXT YET
JRST DOOUT
OUTFIL: CAIN C,"="
PUSHJ P,GETCH ;SKIP OVER EQUALS SIGN
PUSHJ P,GETFIL ;READ FILENAME
JRST INFLE1 ;IMPROPER FILENAME SPEC
SETZB N,AMT ;NO LEFT-OVER TEXT NEEDS OUTPUT YET (AMT)
;HERE IS WHERE WE WILL SCAN /REPLACE, /EXTEND, /ABORT, /SPOOL AND /XSPOOL SWITCHES
OUTFL4: CAIE C,"/" ;SWITCH COMING?
JRST OUTFL2 ;NO
MOVE D,TYPNT
MOVEM D,TTMS+1 ;SET UP TTYMES POINTER IN CASE OF ERROR
MOVE D,[-LOUTSW,,OUTSW] ;POINTER TO TABLE OF SWITCH NAMES
PUSHJ P,FINDS0
JRST SWERR1 ;UNDEFINED SWITCH
JRST SWERR2 ;AMBIGUOUS SWITCH
CAIL D,LPTSW ;FILE EXISTENCE SPEC OR SPOOLING REQUEST?
JRST OUTFL5 ;SPOOLING
TRNE N,-1 ;FILE EXISTENCE SPEC. ALREADY SEEN ONE?
JRST SWERR4 ;YES, SWITCH ERROR
HRRI N,-OUTSW+1(D) ;REMEMBER SWITCH
JRST OUTFL4 ;LOOK FOR MORE SWITCHES
OUTFL5: CAIN D,LPTSW ;SPOOL ON LPT?
TLO N,LPTB ;YES
CAIN D,XGPSW ;SPOOL ON XGP?
TLO N,XGPB ;YES
JRST OUTFL4
OUTFL2: CAIE C,CR ;FILENAME MUST BE FOLLOWED BY CR
JRST SWERR3
SKIPN NCURR
JRST OUTER1 ;NO STORY LIST TO OUTPUT
MOVE A,[FILEF,,W]
BLT A,Z ;COPY FILENAME INTO ACS
JUMPN W,.+2
MOVE W,DOFILE ;PICK UP DEFAULT FILE NAME
TLNN F,GOTEXT
MOVE X,DOFILE+1 ;PICK UP DEFAULT EXTENSION
OUTFL1: OPEN FLO,DSK17
UFATAL 544 ;;;CANT OPEN DSK
MOVE C,Z ;SAVE PPN
LOOKUP FLO,W ;LOOK FOR OLD FILE OF SAME NAME
JRST NOEXS ;NONE THERE
MOVSM Z,AMT ;SAVE FILE LENGTH
MOVE Z,C
OUTSTR [ASCIZ/File already exists: /]
PUSHJ P,PRFILE ;TYPE OUT FILENAME
JRST @EXSDSP(N) ;FILE ALREADY EXISTS -- TAKE APPROPRIATE ACTION
EXSASK: OUTSTR [ASCIZ/
REPLACE, EXTEND or ABORT? /]
MOVE D,[-3,,OUTSW]
PUSHJ P,READ
PUSHJ P,GETCH
CAIN C,"/"
PUSHJ P,GETCH
PUSHJ P,FINDSW
JRST EXSAB1 ;UNDEFINED RESPONSE
JRST EXSASK ;AMBIGUOUS RESPONSE
JRST @EXSDSP-OUTSW+1(D)
EXSAB1: SKIPE BUF2 ;JUST CARRIAGE RETURN MEANS ABORT
JRST EXSASK ;WITH ANY OTHER UNDEFINED RESPONSE, ASK AGAIN
EXSABT: OUTSTR [ASCIZ/. OUTPUT ABORTED./]
RELEAS FLO,
POPJ P,
EXSREP: CLOSE FLO,
JSP A,DOENTR
OUTSTR [ASCIZ/. REPLACING FILE./]
SETZM AMT
JRST DOOUT
NOEXS: OUTSTR [ASCIZ/Creating file: /]
PUSHJ P,PRFILE
MOVEI A,DOOUT
DOENTR: JUMPN Z,.+2
DSKPPN Z,
MOVE B,[W,,OFILE]
BLT B,OFILE+3 ;SAVE FILENAME
ENTER FLO,W
JRST NOENT1 ;TELL WHY ENTER FAILED, BUT DON'T TYPE FILENAME
JRST (A)
EXSEXT: JSP A,DOENTR
OUTSTR [ASCIZ/. EXTENDING FILE./]
MOVN A,AMT ;GET OLD FILE'S WORD COUNT
SETZB B,AMT
LSHC A,-7 ;GET AMT OF TEXT IN LAST RECORD
JUMPE B,EXSEX1 ;ANY?
ROT B,7 ;YES
MOVEM B,AMT ;SAVE FOR FUTURE OUTPUT
USETI FLO,1(A) ;READ FROM LAST RECORD
MOVNI B,(B) ;NEGATIVE WORD COUNT
HRLI B,OLDBUF-1 ;INPUT CMD PTR
MOVSM B,FLOCMD ;DUMP MODE INPUT COMMAND
IN FLO,FLOCMD ;READ LAST PARTIAL RECORD
JRST .+2
UFATAL 550 ;;;DISK INPUT ERROR
EXSEX1: USETO FLO,1(A) ;PREPARE TO WRITE PARTIAL RECORD BACK
DOOUT: SETZM ESCIFG ;ESC I NOT TYPED YET
OUTSTR CRLF
PUSHJ P,COUNT
OUTSTR [ASCIZ / /]
MOVE E,CURREN
DOOUT1: PUSHJ P,REDSTY
JRST OUTER2 ;FAILED TO READ IN STORY
MOVE A,AMT ;get number of words left over last time
MOVE B,STYEND
SUB B,STYBEG ;length of story into B
ADD B,A ;total amount now needing to be output
MOVE D,B
ANDI D,177 ;amount that will be left over this time
MOVEM D,AMT ;save this number for next time
ANDI B,777600 ;amount going out this time
JUMPE B,DOOUT6 ;anything going out now?
MOVN D,B ;yes, make negative word count for dump mode cmd
JUMPN A,DOOUT2 ;any text left over from before?
HRL D,STYBEG ;no, output from beginning of this story
SUB D,[1,,0] ;adjust output cmd ptr
JRST DOOUT3
DOOUT2: MOVS C,STYBEG ;move most of story up to end of left over stuff
HRRI C,OLDBUF(A)
BLT C,OLDBUF-1(B)
HRLI D,OLDBUF-1 ;output cmd ptr
DOOUT3: MOVSM D,FLOCMD ;dump mode output cmd
OUT FLO,FLOCMD
JRST .+2
UFATAL 554 ;;;OUTPUT DISK ERROR
ADD B,STYBEG
SUB B,A ;MAKE PTR TO NEW LEFT-OVER STUFF
HRLZ B,B ;MAKE BLT PTR
TDZA A,A ;no old left-over stuff
DOOUT6: HRLZ B,STYBEG ;ptr to left-over stuff
HRRI B,OLDBUF(A) ;DESTINATION (adding to any old left-over stuff)
SKIPE C,AMT ;get new amount of left over stuff
BLT B,OLDBUF-1(C)
DOOUT7: HRRE A,STYFOL(E) ;SEE IF WE HAVE A FOLLOW-UP FOR THIS STORY
JUMPGE A,DOFOL0 ;JUMP IF ORIGINAL
OUTCHR ["-"] ;WE HAVE JUST OUTPUT A FOLLOW-UP
HRRZ E,STYLST(E) ;GET NEXT FOLLOW-UP
JUMPN E,DOFOLL ;JUMP IF HAVE ANOTHER FOLLOW-UP
MOVN E,A ;GET PTR TO ORIGINAL
DOORIG: HRRZ E,STYLST(E) ;GET NEXT ORIGINAL
MOVSI A,[ASCII/***************
/]
JRST DOFOL1 ;PUT STARS AT END OF STORY
DOFOL0: OUTCHR ["$"] ;WE HAVE JUST OUTPUT AN ORIGINAL
JUMPE A,DOORIG ;JUMP IF ORIGINAL WITHOUT FOLLOW-UP
MOVE E,A ;GET FIRST FOLLOW-UP
DOFOLL: MOVSI A,[ASCII/ - - - - - -
/]
DOFOL1: MOVE B,AMT
HRRI A,OLDBUF(B) ;DESTINATION ADDRESS FOR BLT OF STARS OR STRIPES
ADDI B,4
BLT A,OLDBUF-1(B) ;MOVE STARS OR STRIPES
CAIGE B,200 ;GOT ENOUGH FOR ANOTHER RECORD NOW?
JRST DOFOL2 ;NO
SUBI B,200 ;YES. AMT LEFT OVER AFTER NEXT RECORD
OUT FLO,FLOCM2 ;WRITE OUT 200 WORDS FROM OLDBUF
SKIPA A,[OLDBUF+200,,OLDBUF]
UFATAL 560 ;;;DISK OUTPUT ERROR
BLT A,OLDBUF-1(B)
DOFOL2: MOVEM B,AMT ;SAVE NEW AMT OF LEFT OVER STUFF
SKIPE ESCIFG
JRST DOFOL3 ;USER TYPED ESC I. DISCARD OUTPUT FILE.
JUMPN E,DOOUT1 ;JUMP IF ANY MORE STORIES
MOVN A,AMT ;NO MORE STORIES, FLUSH FINAL LEFT-OVER TEXT
JUMPE A,DOOUT5 ; (IF ANY)
HRLI A,OLDBUF-1 ;output cmd ptr
MOVSM A,FLOCMD
OUT FLO,FLOCMD
JRST .+2
UFATAL 564 ;;;OUTPUT DISK ERROR
DOOUT5: MOVE A,['GODMOD']
SETZ B,
MTAPE FLO,A
MOVEM B,AMT ;REMEMBER FILE SIZE
RELEAS FLO,
;NOW IT'S TIME TO SPOOL THE OUTPUT FILE, IF REQUESTED
TLNE N,LPTB ;SPOOL ON LPT?
PUSHJ P,SPOOLL ;YES
TLNE N,XGPB ;SPOOL ON XGP?
JRST SPOOLX ;YES
POPJ P,
DOFOL3: OUTSTR [ASCIZ/
MANUAL INTERRUPTION. OUTPUT FILE DISCARDED./]
TLZ F,IFILB
RELEAS FLO,3
POPJ P,
OUTER1: OUTSTR [ASCIZ/NO STORY LIST TO OUTPUT./]
POPJ P,
OUTER2: OUTSTR CRLF
PUSHJ P,STYERR
JRST DOOUT7
SPOOLX: TLOA F,TMP1B ;FLAG SPOOLING FOR XGP
SPOOLL: TLZ F,TMP1B ;SPOOLING FOR LPT
SETZB Y,OLDBUF ;WE WILL USE THE 200 WORDS AT OLDBUF AS .SPX FILE
MOVE A,[OLDBUF,,OLDBUF+1]
BLT A,OLDBUF+177 ;CLEAR OUTPUT BUFFER
MOVE A,['NP ',,1]
MOVEM A,OLDBUF ;VERSION NUMBER
MOVE A,USRPPN
MOVEM A,OLDBUF+1 ;PPN OF REQUESTER
SETO A,
GETLIN A
PJOB B, ;JOB NUMBER
HRL B,A
MOVEM B,OLDBUF+2 ;LINE NBR,,JOB NBR
MOVE A,AMT ;GET FILE SIZE IN RECORDS
MOVEM A,OLDBUF+5 ; AND PASS TO SPOOLER
ACCTIM W, ;MAKE FILE NAME AND GET DATE,,TIME IN SECS
HRRZ A,W ;TIME IN SECS
IDIVI A,=60 ;TIME IN MINS
HLL A,W
MOVEM A,OLDBUF+6 ;DATE,,TIME IN MINS
MOVE A,[OFILE,,OLDBUF+7]
BLT A,OLDBUF+12 ;FILE NAME, EXT, PPN
SETZ A, ;CLEAR FLAG BITS TO SPOOLER
TLNN F,TMP1B ;XGP?
MOVEI A,1100 ;NO. NARROW & NOFF BITS FOR LPT
TLNE N,DELB ;DELETE AFTER SPOOLING?
ORI A,1 ;YES
MOVEM A,OLDBUF+16 ;SPOOLER FLAGS
OPEN SPL,DSK17
UFATAL 570 ;;;CANT OPEN DSK
MOVSI X,'SPX'
TLNE F,TMP1B ;XGP?
MOVSI X,'XSP' ;YES
MOVE Z,['SPLSYS']
ENTER SPL,W
AOJA W,[ENTER SPL,W ;TRY A SECOND TIME TO ENTER FILE
JRST SPOOLE ;CANT ENTER SPOOLER COMMAND FILE
JRST .+1]
OUT SPL,FLOCM2 ;WRITE OUT 200 WORDS
JRST SPOOLF
UFATAL 574 ;;;DISK OUTPUT ERROR
SPOOLE: OUTSTR SORRY
OUTSTR [ASCIZ/CAN'T ENTER COMMAND FILE FOR SPOOLER.
OUTPUT FILE NOT SPOOLED./]
SPOOLF: TLNN F,TMP1B ;XGP?
JRST SPOOLG ;NO
SETOM OLDBUF
MOVE A,[OLDBUF,,OLDBUF+1];YES, NEED SECOND RECORD IN COMMAND FILE
BLT A,OLDBUF+7 ;-1 TO GET DEFAULTS FOR ALL XGP MARGINS
SETZM OLDBUF+11
MOVE A,[OLDBUF+11,,OLDBUF+12]
BLT A,OLDBUF+177 ;CLEAR FONT ARRAY
MOVE A,['BASB30']
MOVEM A,OLDBUF+10 ;FONT NAME
; MOVSI A,'FNT'
; MOVEM A,OLDBUF+11 ;EXTENSION
; MOVE A,['XGPSYS']
; MOVEM A,OLDBUF+13 ;PPN
OUT SPL,FLOCM2 ;WRITE OUT SECOND RECORD
JRST SPOOLG
UFATAL 600
SPOOLG: RELEAS SPL,
SETZM OLDBUF
MOVE A,[OLDBUF,,OLDBUF+1]
BLT A,OLDBUF+37 ;CLEAR BUFFER TO BE MAILED
MOVE A,['[LIST]']
TLNE F,TMP1B ;XGP?
MOVE A,['[XSPL]'] ;YES
MOVEI B,OLDBUF
SKPSEN A ;KICK THE SPOOLER
POPJ P,
POPJ P,
POPJ P,
;SETTIM SETBEG SETEND EDT PDT
;ROUTINE TO ADJUST SYSTEM DATE IN B BY NUMBER OF DAYS (+ OR -) IN D (-28.≤D≤28.)
;CLOBBERS ACs D,L,M,N. RETURNS ADJUSTED DATE IN B.
CHGDAY: JUMPE D,CPOPJ
MOVEI N,(B) ;OLD SYSTEM DATE
ADD B,D ;APPROXIMATE NEW SYSTEM DATE
MOVE L,B
DAYCNT N, ;OLD DAYCNT DATE
ADD N,D ;NEW DAYCNT DATE
JUMPG D,ADDDAY ;JUMP IF POSITIVE ADJUSTMENT
DAYCNT L, ;APPROX NEW DAYCNT DATE
ADD B,N
SUB B,L
POPJ P,
ADDDAY: MOVEI D,3 ;LOOK FORWARD 3 DAYS FOR SYSTEM DATE WITH RIGHT DAYCNT
ADDDA1: AOS M,L ;NEXT SYSTEM DATE
DAYCNT M,
CAIN M,(N) ;THIS DATE HAVE CORRECT DAYCNT VALUE?
SKIPA B,L ;YES
SOJG D,ADDDA1 ;NO, LOOK SOME MORE
POPJ P, ;NO OTHER CORRECT DAYCNT. APPROX SYSTEM DATE OK.
EDT: SETZ D, ;DAY OFFSET
ADDI C,3*=60 ;CONVERT TO EASTERN TIME
CAIGE C,=24*=60 ;NEXT DAY?
POPJ P, ;NO
SUBI C,=24*=60 ;YES, BACK UP 24 HOURS AND
ADDI D,1 ; ADVANCE A DAY
POPJ P,
PDT: SETZ D, ;DAY OFFSET
SUBI A,3*=60 ;CONVERT TO PACIFIC TIME
JUMPGE A,CPOPJ ;PREV DAY?
ADDI A,=24*=60 ;YES, ADVANCE 24 HOURS AND
SUBI D,1 ; BACK UP A DAY
POPJ P,
SETTIM: MOVEI Q,1
SETTM0: MOVE A,TIME1(Q) ;OLD TIME
MOVE B,SDATE1(Q) ;OLD DATE (SYSTEM)
MOVE C,NTIME1(Q) ;NEW TIME
MOVE D,NDATE1(Q) ;NEW DATE (SYSTEM)
MOVEM A,W(Q) ;SAVE OLD TIME
JUMPGE C,.+2 ;JUMP IF NEW TIME GIVEN
JUMPE D,SETTM8 ;JUMP IF NO NEW TIME OR DATE GIVEN
HRRZS (P) ;SET FLAG INDICATING TIME/DATES CHANGED
JUMPN D,SETTM2 ;JUMP IF NEW DATE GIVEN
JUMPL A,SETTM4 ;JUMP IF NO OLD TIME GIVEN
PUSHJ P,PDT ;CONVERT OLD TIME TO PDT
PUSHJ P,CHGDAY ;ADJUST OLD DATE
JRST SETTM4
SETTM2: MOVE B,D ;NEW DATE
JUMPL C,SETTM3 ;JUMP IF NO NEW TIME
SETTM4: PUSHJ P,EDT ;CONVERT NEW TIME TO EDT
PUSHJ P,CHGDAY ;ADJUST NEW DATE
SETTM3: MOVEM C,W(Q) ;SAVE NEW TIME
SETTM8: MOVEM B,Y(Q) ;SAVE NEW DATE
SOJGE Q,SETTM0 ;DO BEGINNING TIME/DATE NEXT
HLLZ A,(P) ;GET FLAG
JUMPN A,CPOPJ ;JUMP IF NO CHANGES TO TIMES/DATES
JUMPN X,SETTM7 ;JUMP UNLESS ENDING TIME IS 0000
MOVEI X,=24*=60 ;MAKE ENDING TIME 2400 ON PREV DAY
MOVEI B,(Z) ;ENDING DATE
SETO D, ;PREVIOUS DATE
PUSHJ P,CHGDAY ;ADJUST DATE
MOVEI Z,(B) ;SAVE ADJUSTED DATE
SETTM7: JUMPL W,SETTM9 ;JUMP IF NO BEGINNING TIME GIVEN
JUMPL X,SETTM9 ;JUMP IF NO ENDING TIME GIVEN
CAIE Y,(Z) ;BEGINNING AND ENDING ON SAME DATE?
JRST SETTM9 ;NO
CAILE W,(X) ;YES, ENDING TIME BEFORE BEGINNING TIME?
SPCERR ILLEGAL TIME RANGE
SETTM9: CAMG Z,STODAY ;ENDING DATE AFTER TODAY?
JRST .+3 ;NO
MOVE Z,STODAY ;YES, END ON TODAY
SETO X, ; WITH NO TIME LIMIT
CAML Y,SFSTDA ;BEGINNING DATE BEFORE FIRST AVAILABLE NEWS?
JRST .+3 ;NO
MOVE Y,SFSTDA ;YES, BEGIN WHEN NEWS BEGINS
SETO W, ; WITH NO TIME LIMIT
CAIGE Z,(Y) ;NO, BEGINNING DATE AFTER ENDING DATE?
SPCERR ILLEGAL DATE RANGE
MOVEM W,TIME1 ;SAVE BEGINNING TIME
MOVEM X,TIME2 ;SAVE ENDING TIME
MOVEM Y,SDATE1 ;SAVE BEGINNING DATE
MOVEM Z,SDATE2 ;SAVE ENDING DATE
DAYCNT Y,
DAYCNT Z,
MOVEM Y,DATE1 ;BEGINNING DAYCNT DATE
MOVEM Z,DATE2 ;ENDING DAYCNT DATE
PUSHJ P,DATES0
OUTSTR CRLF
POPJ P,
;DATA PATCH
IFN DEBUG,<
PATCH: BLOCK 20
>
LIT
VAR
DATA: 0 ;.DAT FILE GOES HERE. CORE EXPANDED TO FIT IT
END GAP